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The  Hazard  Assessment  Computer  System  (HACS)  is  one  of  six  major 
components  of  the  U.S.  Coast  Guard's  Chemical  Hazards  Response  Information 
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operation  of  HACS  with  remote  access  for  users  to  the  central  computer 
facility  by  means  of  remote  terminals.  The  final  report  provides 
documentation  of  the  internal  structure  of  the  HACS/tJIM  as  developed  for  use 
by  the  USOG  on  the  Cybernet  System  of  Control  Data  Corporation.  The  UIM 
controls  the  user  interaction  with  HACS  by  means  of  a  question  and  answer 
dialog;  all  user  responses  are  interpreted  by  the  UIM  without  input 
formatting  restrictions  using  a  series  of  terminal  input  utility  functions. 
An  overview  of  the  internal  structure  of  HACS/UIM  is  given  in  terms  of  both 
sub-program  modules  and  sequence  of  operations.  Descriptions  of  all 
required  HACS  data  files  are  given;  these  include  a  chemical  and  physical 
property  data  file  for  the  900  hazardous  chemicals.  Additional  descriptive 
text  and  detailed  input  data  explanations  are  stored  in  external  files  for 
retrieval  and  display  under  user  control.  Complete  program  listings  for  the 
HACS/UIM  and  associated  computer  programs  are  included  in  the  report. _ 
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1.  INTRODUCTION 


The  Chemical  Hazard  Response  Information  System  (CHRIS)  is  designed  to 
provide  timely  information  essential  for  proper  decision-making  by  re¬ 
sponsible  Coast  Guard  personnel  and  others  during  emergencies  involving 
the  water  transport  of  hazardous  chemicals.  A  secondary  purpose  is  the 
provision  of  certain  basic  non-emergency-related  information  to  support 
the  Coast  Guard  in  its  efforts  to  achieve  improved  levels  of  safety  in  the 
bulk  shipment  of  hazardous  chemicals. 

CHRIS  consists  of  four  reference  guides  or  manuals,  a  regional  contingency 
plan,  and  a  hazard  assessment  computer  system  (HACS).  The  four  manuals 
contain  chemical  data,  hazard  assessment  methods,  and  response  guides. 
Regional  data  are  included  in  the  Coastal  Regional  Contingency  Plans. 
Elements  of  the  Coast  Guard  Headquarters  staff  operate  the  hazard 
assessment  computer  system  and  provide  technical  assistance  on  request  by 
field  personnel  during  emergencies.  In  addition,  they  are  responsible  for 
periodic  update  and  maintenance  of  CHRIS.  A  brief  description  of  each 
major  component  of  CHRIS  is  provided  in  Section  2  of  this  report. 

This  report  documents  the  internal  computer  program  structure  of  the 
Hazard  Assessment  Computer^System  (HACS)  as  it  operates  on  Control  Data 
Corporation's  Cybernet  Service  with  the  User  Interface  Module  (UIM).  A 
second  report,  the  HACS/UIM  Users'  Operation  Manual,  contains  additional 
information  which,  although  not  duplicated  in  this  report,  is  useful  for 
understanding  the  internal  operation  of  the  HACS/UIM.  A  third  report,  the 
HACS  Program  Reference  Manual,  contains  detailed  technical  documentation 
of  the  earlier  batch  version  of  the  system  as  it  operated  on  the  CDC  3300 
computer  at  USCG  Headquarters;  although  the  batch  operation  has  now  been 
replaced  by  an  interactive  mode,  much  of  this  earlier  documentation  gives 
useful  background  on  the  current  internal  structure  of  the  HACS/UIM. 

s 

HACS  is  comprised  of  a  specific  set  of  hazard  assessment  models,  chemical 
specific  data,  and  an  overall  system  structure  to  provide  data  control  and 
output  displays.  Two  separate  computer  programs  are  used  to  define  and 
produce  independent  displays  of  the  chemical  specific  data;  the  use  and 
capabilities  of  these  programs  are  described  in  separate  reports. 

Also  to  assist  in  obtaining  the  compound  recognition  code  used  to  reference 
data  for  a  particular  chemical,  a  separate  set  of  indices  have  been 
produced  and  are  given  in  a  separate  report.  These  indices  enable  a  user 
of  HACS  to  obtain  a  recognition  code  for  a  chemical  given  either  the 
compound  name  or  a  synonym. 

In  addition  to  the  file  of  chemical  specific  data,  HACS  uses  another 
independent  set  of  data  referred  to  as  the  default  file.  Default  file  data 
is  used  by  HACS  during  execution  to  define  the  structure  of  internal  HACS 
processing  files.  The  elements  and  current  data  contained  in  the  default 
file  are  described  in  the  HACS  User  Reference  Manual.  The  HACS  default  file 
provides  the  primary  control  within  the  UIM  for  interactive  requests  for 
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user  input  data. 

The  individual  hazard  assessment  models  contained  in  HACS  are  basically 
organized  as  separate  programs,  arranged  as  overlays,  which  are  retrieved 
and  executed  under  the  control  of  the  HACS  executive  system.  Each  separate 
program  includes  a  framework  within  which  data  items  (environmental 
conditions,  chemical  properties,  model  parameters,  user  options,  etc.)  are 
transferred  from  HACS  data  files  to  the  rate  model,  and  results  obtained 
from  model  computations  are  stored  in  HACS  files.  The  program  code  for  the 
individual  assessment  models,  and  associated  subroutines,  is  included  in 
this  report,  however,  the  theoretical  basis  for  these  models  is  described 
in  Assessment  Models  in  Support  of  the  Hazard  Assessment  Handbook 
published  by  the  U.S.  Coast  Guard  in  January  1974.  A  later  report  entitled 
"Development  of  Additional  Hazard  Assessment  Models"  describes  new  models 
developed  and  incorporated  into  HACS  during  1976. 

This  manual  assumes  a  thorough  familiarity  with  the  contents  of  the  HACS 
User  Reference  Manual,  and  uses  the  principles  of  operations  described  in 
that  manual  as  the  basis  for  technical  documentation  of  the  internal 
program  structure. 

Most  HACS  program  code  is  written  in  Fortran  IV,  avoiding  machine  dependent 
features  or  coding  as  much  as  possible.  However,  the  development  of  the 
UIM  and  associated  capabilities  for  the  operation  of  HACS,  and  the  extended 
file  storage  requirements , for  explanatory  text,  have  required  a  greater 
use  of  specialized  coding  than  was  necessary  with  earlier  versions  of  HACS. 
The  purpose  and  function  of  these  portions  of  HACS  are  described  in  the 
detailed  program  listings;  for  operation  of  HACS  on  other  computer 
equipment,  changes  in  programming  syntax  will  be  necessary  to  preserve  the 
same  functions. 

In  overview,  HACS  consists  of: 

(1)  A  large  operating  program  for  the  HACS/UIM, 

(2)  A  set  of  procedures  used  on  Cybernet  for  program  execution  and 
supporting  operations,  and 

(3)  A  set  of  additional  computer  programs  which  provide  supporting 
functions  primarily  for  maintenance  or  conversion  of  data  files 
used  by  the  HACS/UIM . 

Sections  3  and  4  of  this  report  contain  general  information  regarding  the 
current  structure  and  operation  of  the  HACS/UIM.  Section  5  contains  the 
detailed  HACS/UIM  computer  program  listings,  each  with  narratives  and 
identification  of  all  internal  variables  or  parameters.  Section  6  gives  a 
brief  description  of  the  procedure  used  on  Cybernet  to  run  the  HACS/UIM; 
details  of  the  use  of  Cybernet  services  for  editing,  program  compilation 
and  other  similar  operations  required  for  program  development  are  beyond 
the  scope  of  this  report.  Details  of  the  additional  supporting  computer 


2 


programs  which  were  prepared  during  the  UIM  project  are  given  in  Section  7. 
This  section  contains  statements  of  program  purpose  and  function,  and 
complete  program  listings  are  included. 

The  HACS/UIM  has  evolved  through  a  series  of  stages  in  which  additional 
desired  features  have  been  identified  as  experience  with  the  interim 
versions  of  the  UIM  has  been  gained.  Readers  of  this  report  are  cautioned 
that  the  HACS/UIM  is  a  dynamic  system,  and  changes  are  being  made 
continually  in  response  to  new  desired  features  or  system  capabilities,  to 
new  computer  operations  or  use  within  the  Coast  Guard,  and  to  requirements 
which  result  from  other  related  Coast  Guard  projects.  (For  example,  the 
preparation  of  chemical  specific  physical  property  estimates  will  lead  to 
a  significant  re-structuring  of  the  MACS  physical  property  interface.) 
Thus  the  program  listings  as  contained  in  this  report  can  only  document  the 
system  at  one  particular  stage  in  its  development. 
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2.  COMPONENTS  OF  THE  CHEMICAL  HAZARD  RESPONSE  INFORMATION  SYSTEM  (CHRIS) 

2.1  A  Condensed  Guide  to  Chemical  Hazards  (COMDTINST  Ml6465.il) 


The  Condensed  Guide  contains  information  needed  to  help  personnel  make  the 
proper  response  in  an  emergency  situation;  it  is  the  only  CHRIS  handbook 
that  will  be  carried  to‘thevactual  scene  of  an  accident.  It  is  intended  for 
use  by  port  security  personnel  and  others  who  may  be  the  first  to  arrive  at 
the  site  of  an  accidental  discharge  or  fire  and  who  need  readily  available 
and  easily  understood  information  about  the  hazardous  properties  of  the 
chemical  involved.  It  will  be  used  to  determine  the  proper  actions  that 
should  be  taken  immediately  to  safeguard  life  and  property  and  to  prevent 
contamination  of  the  environment. 

COMDTINST  M16465.ll  briefly  describes  the  chemical  and  biological  hazards 
of  various  materials  so  that  personnel  at  the  scene  of  an  accident  can 
assess  the  danger  and  consider  the  appropriate  large-scale  response.  It 
also  lists  the  on-scene  information  needed  for  proper  use  of  the  Hazard 
Assessment  Handbook  (COMDTINST  M16465.13).  Selected  information  on  each 
chemical  covered  by  CHRIS  is  summarized  from  the  more  extensive  material  in 
the  Hazardous  Chemical  Data  Manual  (COMDTINST  M16465.12)  and  is  presented 
on  a  single  page. 

2.2  Hazardous  Chemical  Data  (COMDTINST  M16465.12) 


This  manual  is  the  cornerstone  of  CHRIS.  For  each  substance,  it  lists  the 
specific  chemical,  physical,  and  biological  data  needed  for  the  prepara¬ 
tion  and  use  of  the  other  components  of  the  system.  It  can  also  be  used 
after  the  initial  response  action,  when  there  is  sufficient  time  to  use 
more  detailed  information  than  that  found  in  COMDTINST  Ml6465.il.  The 
first  of  the  six  pages  devoted  to  each  chemical  is  a  duplicate  of  the 
corresponding  page  in  COMDTINST  Ml 6465. 11. 

COMDTINST  M16465.12  is  intended  for  use  primarily  by  the  On-Scene 
Coordinator  (OSC)  and  by  Regional  and  National  Response  Centers  for 
devising,  evaluating,  and  carrying  out  response  plans. 

Much  of  the  quantitative  information  found  in  COMDTINST  M16465.12  is 
needed  for  the  hazard  assessment  calculations  described  in  the  Hazard 
Assessment  Handbook  (COMDTINST  M16465.13).  COMDTINST  M16465.12  contains 
the  so-called  Hazard  Assessment  Code,  which  directs  the  user  of  COMDTINST 
M16465.13  to  the  appropriate  calculation  procedures  of  hazard  assessment. 
COMDTINST  M16465.12  also  suggests  general  responses  to  an  accidental 
discharge,  which  summarize  the  detailed  information  given  in  the  Response 
Methods  Handbook  (COMDTINST  M16465.14). 

2.3  Hazard  Assessment  Handbook  (COMDTINST  M16465.13) 


The  Hazard  Assessment  Handbook  describes  procedures  to  be  used  for 
estimating  the  quantity  of  a  hazardous  chemical  that  may  be  released 
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accidentally  during  shipment.  It  also  describes  how  to  estimate  its 
concentration  in  air  and  in  water  as  a  function  of  time  and  distance  from 
the  discharge.  Methods  for  predicting  the  resulting  toxicity,  fire,  and 
explosion  effects  are  also  described.  The  calculations  use  data  from 
COMDTINST  M16465.12. 


2.4  Hazard  Assessment  Computer  System^ 


The  Hazard  Assessment  Computer  System  (HACS)  is  a  computerized  version  of 
COMDTINST  M16465.13.  It  permits  trained  headquarters  specialists  to 
obtain  very  detailed  hazard  evaluations  quickly,  when  requested  by  OSC 
personnel. 


In  addition  to  computer  models  for  hazard  assessment  computations,  HACS 
includes  several  related  computer  based  systems  such  as  the  physical 
property  update  and  data  retrieval  programs,  and  the  chemical  compound 
name  and  synonym  cross-reference  programs.  Although  HACS  and  COMDTINST 
M16465.12  are  based  on  the  same  original  body  of  data,  differences  may 
occasionally  arise  because  HACS  is  more  readily  updated  than  the  printed 
manual . 


2.5  Response  Methods  Handbook-  (COMDTINST  M16465.14) 

The  Response  Methods  Handbook  is  written  specifically  for  Coast  Guard  OSC 
personnel  who  have  had  some  training  or  experience  in  hazard  and  pollution 
response.  The  handbook  describes  cautionary  and  corrective  response 
methods  for  reducing  and  eliminating  hazards  that  result  from  chemical 
discharge . 

Although  several  types  of  response  are  suggested  in  COMDTINST  M16465.12, 
the  specific  response,  to  be  chosen  from  among  those  described  in  COMDTINST 
M16465.14,  should  be  determined  by  the  results  of  the  hazard  assessment 
procedures  in  COMDTINST  M16465.13. 

2.6  Data  Base  for  Regional  Contingency  Plan 

The  Coast  Guard's  Regional  Contingency  Plans,  although  not  considered  a 
part  of  CHRIS,  are  an  important  adjunct  to  the  system.  Each  Regional 
Contingency  Plan  contains  a  section  (Annex  XX)  that  presents  data  on  a 
specific  region,  sub-region,  or  locale.  These  data,  which  are  intended  for 
use  by  OSC  personnel,  include  such  information  as  the  following: 

•  An  inventory  of  physical  resources  and  strike  forces; 

•  Vulnerable  or  exposed  resources  (critical  water-use  areas); 

•  Potential  pollution  sources; 

•  Geographic  and  environmental  features; 

•  Cooperating  organizations;  and 

•  Recognized  experts  with  identified  skills. 
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3.  OVERVIEW  OF  INTERNAL  PROCESSING 


The  HACS/UIM  is  composed  of  a  number  of  different  program  components;  these 
inc lude : 

•  Executive  system  -  to  control  the  overall  sequence  of  opera¬ 
tions,  to  provide  utility  functions  for  assessment  model  use, 
and  to  control  the  method  of  assessment  model  operation  with  the 
UIM  (i.e.,  user  input  and  model  summary  modes). 

•  Assessment  models  -  a  series  of  separate  computer  programs 
retrieving  required  data  from  the  HACS  state  file,  performing 
the  indicated  assessment  computations,  storing  computed  values 
in  the  state  file  for  subsequent  use  and  generating  displays  of 
computed  results  at  the  user  terminal. 

•  Overlay  control  -  used  by  the  HACS  executive  system  to  select  and 
execute  the  appropriate  portion  of  the  computer  program,  seg¬ 
mented  into  overlays,  for  each  step  required  in  an  assessment 
computat ion . 

•  Input  sequence  control  -  to  control  the  initialization  of  the 
HACS  state  file,  user  specification  of  the  chemical  recognition 
code  and  hazard  assessment  path  code,  and  user  selection  of 
output  display  units. 

•  Property  data  processor  -  to  retrieve  requested  data  from  the 
property  file,  perform  unit  conversions  to  internal  HACS  CGS 
units,  to  compute  values  of  functions  of  temperature,  and  to 
transfer  chemical  specific  property  data  to  the  HACS  state  file. 

•  Terminal  input  processing  -  a  series  of  related  functions  to 
perform  the  reading  of  user  entries  typed  at  a  terminal  in  a  free 
format  mode,  and  either  transfer  the  resulting  values  to  other 
portions  of  HACS  or  issue  diagnostic  messages  to  the  user 
terminal  and  process  corrections. 

•  State  file  interface  -  a  series  of  routines  which  control  the 
transfer  of  data  values  between  the  HACS  state  file  and  the 
hazard  assessment  models.  For  the  UIM,  these  routines  perform 
additional  functions  to  enable  an  assessment  model,  when  ac¬ 
cessing  the  state  file  to  obtain  a  data  value  not  yet  entered,  to 
initiate  an  interactive  request  to  the  user  terminal  to  obtain 
the  value.  Similarly,  the  interface  also  provides  for  the 
summary  of  model  input  values  prior  to  the  execution  of  the 
mode  1 . 

•  Message  processing  -  to  enable  HACS  to  access  external  files  of 
descriptive  explanations  for  individual  data  items,  hazard 
assessment  models  and  hazard  assessment  scenarios. 
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•  Code  interpretation  -  a  series  of  generalized  routines  used  to 
translate  packed  codes  from  external  file  structures  to  forms 
for  internal  HACS  use.  These  routines  were  developed  to  permit 
compaction  of  HACS'  external  file  storage  requirements. 

•  Printer  plotting  -  routines  provide  a  generalized  utility 
producing  graphic  displays  at  the  user  terminal.  All  scaling 
functions  are  performed  automatically,  and  are  based  on  the 
magnitude  of  the  data  points  displayed  to  obtain  even  or  uniform 
axis  labeling.  The  off-line  plotting  capability  formerly 
contained  in  HACS  Overlay  2  has  been  obsolete  for  some  time,  and 
has  been  deleted  from  the  UIM  version. 

These  components  utilize  a  number  of  both  internal  and  external  files  in 
their  operations: 

•  Program  file  -  a  permanent  disk  file  containing  pre-compiled 
HACS  program  code  in  overlay  and  segment  structure.  The  HACS 
executive  system  automatically  accesses  this  file  to  load 
portions  of  the  HACS  program  code  into  computer  memory  for 
execution  as  required. 

•  State  file  -  an  internal  program  file  constructed  by  HACS  during 
an  assessment  run;  provides  data  base  storage  for  all  user 
input,  property,  default  and  computed  data  items  utilizing  a 
data  quality  priority  structure. 

•  Default  file  -  a  permanent  disk  file  defining  the  structure  of 
the  HACS  state  file,  and  containing  estimated  values  for  HACS 
data  items  to  be  used  only  in  the  absence  of  any  other  value. 

•  Chemical  properties  file  -  a  magnetic  tape  file  containing 
predefined  physical  property  data  for  900  hazardous  chemical 
substances. 

•  Save  file  -  an  internal  program  file  containing  a  copy  of  a  HACS 
state  file  after  completion  of  user  input  operations.  Permits 
HACS  re-runs  requiring  only  new  input  values  to  be  used. 

•  Message  files  -  three  external  files  which  contain  coded  or 
uncoded  variable  length  text  descriptions  of  HACS  data  fields, 
assessment  models  and  assessment  scenarios. 

•  User  terminal  -  although  not  actually  a  file  in  the  usual  sense, 
the  user  terminal  is  the  source  of  input  data  requested 
interactively  by  the  UIM  during  a  hazard  assessment  computation. 

Further  descriptions  of  the  functions  of  these  files  is  contained  in 
Section  2  of  the  HACS/UIM  Users'  Operation  Manual;  additional  detailed 
information  regarding  file  structure  and  other  characteristics  is  given  in 
Section  4  of  this  report. 
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3.1  Overlay  Structure 


Due  to  the  amount  of  program  code  contained  in  HACS,  and  memory  limitations 
on  the  CDC  3300  computer  system,  the  batch  version  of  HACS  originally 
installed  at  USCG  Headquarters  consisted  of  a  series  of  program  overlays 
that  are  loaded  into  memory  and  executed  as  needed  under  the  control  of  the 
HACS  executive  system.  The  overlay  structure  was  transferred  when  HACS  was 
installed  on  Cybernet,  and  remains  in  the  UIM  version.  An  over-riding 
consideration  in  the  design  of  the  overlay  structure  was  the  anticipation 
of  future  modifications,  enhancements  or  even  replacements  that  might 
develop  as  a  result  of  advances  in  hazard  assessment  technology.  Also  the 
fact  that  HACS  is  constructed  to  proceed  along  any  user  specified  path  of 
the  hazard  assessment  event  chart  led  to  establishing  individual  rate 
models  within  separate  overlays. 

Overlay  capabilities  are  defined  for  3  levels.  The  main  or  root  overlay, 
0,  is  resident  at  all  times  and  uses  a  system  utility  to  load  and  execute 
any  one  of  a  multiple  number  of  second  level  overlays.  Each  of  these  may, 
in  turn,  load  and  execute  any  one  of  a  multiple  number  of  third  level 
overlays  which  are  referred  to  as  segments.  Each  overlay  or  segment  is 
executed  as  a  separate  program.  Subroutines  resident  in  a  higher  level 
overlay  may  be  referenced.  On  completion  of  the  execution  of  the  separate 
overlay  or  segment  program,  control  returns  to  the  higher  level  overlay 
immediately  following  the  location  at  which  control  was  transferred  to  the 
completed  overlay  or  segment. 

Overlay  0  contains  the  program  and  subroutines  comprising  the  HACS 
executive  system  and  is  resident  during  all  stages  of  a  HACS  run.  In 
addition,  overlay  0  contains  a  number  of  utility  routines  and  library 
functions  used  by  the  rate  models,  system  I/O  routines  and  the  overlay  and 
segment  control  functions.  Overlay  1  contains  both  the  input  sequence 
control  and  property  data  processors;  overlay  2  contained  the  off-line 
plot  generator  and  has  been  deleted. 

Assessment  rate  models  are  contained  in  the  remaining  overlays,  3  to  8. 
Overlays  3  and  6  contain  only  a  single  rate  model  each.  The  first  part  of 
each  of  these  overlays  is  coded  as  a  main  program  which  performs  the 
functions  of  retrieving  model  input  from  the  HACS  state  file,  calling  the 
appropriate  rate  model  subroutines  to  perform  the  indicated  assessment 
computations,  then  storing  the  results  of  these  computations  in  the  HACS 
state  file. 

Overlays  h,  5  and  7  each  contain  a  multiple  number  of  related,  or 
independent  rate  models.  For  each  of  these,  a  separate  main  program  exists 
to  interface  with  the  HACS  executive  system  to  select  the  appropriate  rate 
model  for  execution.  Then  the  first  part  of  each  individual  model,  coded 
as  a  subroutine,  performs  the  functions  of  HACS  data  base  I/O  and  executes 
the  particular  sequence  of  assessment  computations. 

Overlay  8  is  a  small  control  program,  with  resident  multi-use  routines  for 
assessment  computations,  used  to  branch  to  one  of  six  segment  level 
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overlays.  Each  of  segments  1,  3,  4,  5  and  6  are  organized  in  a  manner 
similar  to  overlays  3  and  6.  That  is,  a  separate  program  provides  HACS  data 
base  I/O,  then  subroutines  in  the  segment  are  called  to  perform  the 
particular  assessment  computations.  Note  that  these  subroutines  may  in 
turn  call  multi-use  subroutines  in  overlays  8  and/or  0.  Segment  2  contains 
a  separate  main  program  to  select  between  models  K  and  P.  Each  of  these 
models  is  then  controlled  by  a  subroutine  which  provides  separate  HACS  data 
base  control. 

Internal  HACS  data  files  are  resident  in  overlay  0. 

3.2  Sequence  of  Operations 

The  basic  HACS  functions  are  to  process  user  inputs  to  select  available 
options  or  to  enter  data  values,  execute  rate  models,  and  display  the 
results  of  these  computations  at  the  user  terminal.  These  operations  are 
sequenced  internally  by  the  executive  system  resident  in  overlay  0  which 
first  executes  overlay  1  to  initiate  the  user  input  operation  for  chemical 
and  hazard  assessment  path  selection.  When  the  user  entry  of  the  chemical 
recognition  code  has  been  read,  HACS  automatically  accesses  the  external 
physical  properties  file  and  retrieves  the  corresponding  data  record.  The 
chemical  property  values  are  uncoded,  converted  and  stored  in  the  HACS 
state  file  for  later  use.  Also,  at  this  stage,  the  codes  for  appropriate 
models  and  scenarios  for  the  chemical  are  retrieved  from  this  file,  and 
used  to  control  optional  displays  which  can  be  requested  by  the  user. 
During  the  input  sequence  which  occurs  in  overlay  1,  the  HACS  state  file  is 
initialized  with  default  values,  and  on  return  to  overlay  0  the  state  file 
contains  only  default  and  chemical  property  values. 

Next,  the  HACS/UIM  uses  the  user  specified  list  of  hazard  assessment  model 
codes  and  proceeds  to  execute  each  model  by  calling  the  appropriate 
overlay.  The  HACS  executive  initializes  a  flag  for  each  model  to  a  value 
of  zero;  after  each  execution  the  flag  is  set  to  1  so  that  the  first 
execution  of  each  rate  model  can  be  identified.  As  each  model  is  executed 
a  series  of  subroutine  calls  are  processed  to  obtain  the  necessary  model 
input  values  from  the  HACS  state  file.  In  the  state  file  interface 
portions  of  the  system,  if  the  value  in  the  state  file  is  a  default  value 
and  if  the  model  is  being  executed  for  the  first  time,  the  HACS/UIM  does  not 
use  the  value  in  the  state  file  but  instead  issues  a  prompt  at  the  terminal 
to  obtain  a  value  from  the  user.  User  responses  (input  of  a  value,  query 
for  the  current  value,  or  request  for  description)  are  processed,  and  this 
procedure  is  repeated  for  each  data  item  until  all  model  inputs  have  been 
obtained.  The  HACS/UIM  then  prints  a  summary  of  the  model  input  values  (by 
re-executing  the  model  itself  a  second  time),  and  provides  an  opportunity 
for  the  user  to  change  any  previously  entered  value.  If  any  changes  are 
made,  the  model  input  summary  is  repeated  before  the  hazard  assessment 
computation  is  done.  Following  the  computation  and  display  of  results,  the 
HACS  executive  processes  an  optional  user  request  to  re-run  the  model.  In 
this  case  the  user  prompts  for  data  input  are  suppressed,  and  the  model 
input  summary  is  displayed. 
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Each  hazard  assessment  model  is  similarly  executed  until  all  models 
requested  by  the  user  have  been  run.  The  HACS/UIM  then  processes  a  user 
option  to  obtain  displays  of  selected  values  from  the  HACS  state  file  and 
the  basic  run  is  completed.  In  overlay  0  and  then  overlay  1,  further  user 
input  responses  determine  whether  a  new  run  is  initiated  or  further 
operation  of  the  program  is  terminated. 

The  HACS/UIM  Users'  Operation  Manual  contains  additional  summary  discus¬ 
sion  of  the  processing  steps  of  a  HACS/UIM  run,  and  a  complete  description 
of  the  terminal  displays  produced  during  a  typical  run. 
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4.  HACS  DATA  FILE  STRUCTURES 


HACS  utilizes  several  external  and  internal  files  for  input  data  manipula¬ 
tion  and  storage  during  operation,  in  addition  to  fixed  internal  data  items 
used  for  unit  label  interpretation,  output  reporting,  etc.  These  files  are 
identified  and  described  below  in  detail  where  appropriate  or  by  reference 
to  other  documentation. 

4.1  Chemical  Properties  File 

The  chemical  properties  file  is  an  external  file  of  physical  property  data 
which  may  be  accessed  on  either  magnetic  tape  or  disk;  the  file  currently 
contains  properties  for  900  compounds,  although  additional  compounds  are 
expected  to  be  added  in  the  near  future.  Due  to  the  length  of  this  file, 
the  original  version  of  HACS  utilized  binary  rather  than  source  data 
formats.  This  machine  dependent  format  has  been  retained  throughout  all 
later  versions  of  HACS  and  requires  separate  translation  programs  to  move 
copies  of  the  property  file  from  machine  to  machine. 

A  detailed  description  of  the  original  file  structure  is  given  in  the 
report  "HACS  Physical  Property  File  Update  and  Maintenance  -  User  and 
Technical  Program  Documentation." 

For  use  with  the  UIM,  two  significant  changes  have  been  made  to  the 
property  file  format.  First,  the  hazard  assessment  model  codes  originally 
entered  on  the  file  were  used  to  create  chemical  specific  codes  for  both 
models  and  scenarios,  and  these  codes  are  now  contained  on  the  file. 
Second,  a  substantial  portion  of  the  data  elements  contained  in  the  file 
are  missing  (i.e.,  not  available  or  not  pertinent),  and  a  coding  scheme  has 
been  used  to  further  compact  the  file. 

The  version  of  the  UIM  described  in  this  report  uses  a  property  file 
consisting  of  a  header  record  followed  by  900  data  records,  one  per 
chemical.  The  header  record  format  has  not  been  changed.  Each  data  record 
however  is  now  treated  as  a  variable  length  record,  having  a  maximum  length 
of  84  words.  A  third  record  structure,  consisting  of  variable  length 
logical  records  packed  into  fixed  length  physical  record  blocks,  has  been 
developed  for  use  on  machines  not  having  the  required  variable  length 
record  facilities  (see  Section  7). 

The  variable  length  record  format  used  by  the  current  version  of  the  UIM 
operating  on  Cybernet  is  described  below: 

Record 

Element  Description 

1  Chemical  recognition  code,  three  letter  code  in  integer 

word . 

2  -  6  Chemical  name,  up  to  40  characters  in  length  stored  as  8 

characters  per  word  in  integer  format. 
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Record 

Element  Description 

7  Hazard  assessment  model  codes  applicable  to  particular 

chemical,  stored  as  single  bit  settings  in  single  integer 
word;  uses  29  positions  in  word.  Codes  are  0  =  model  not 
applicable,  1  =  model  applicable. 

8  Scenario  codes,  stored  as  single  bit  settings  to  correspond 

to  internal  HACS  data  list  of  scenario  codes  (e.g.,  bit  5 
set  to  1  indicates  HACS  scenario  5  is  applicable). 

9  •  13  Property  value  status  codes,  stored  as  2  bits  per  code,  15 

codes  per  word.  Codes  are  0  =  missing,  2  =  estimate,  and  3 
=  exact.  If  code  for  item  I  is  given  as  0,  then  that  item 
does  not  appear  in  following  data. 

14  -  84  Space  for  up  to  71  data  values  for  chemical,  starting  with 

molecular  weight.  All  missing  values  are  removed,  so  that 
positions  14,  15,  etc.  contain  only  actual  data  values. 

Excess  space  remaining,  if  any,  at  end  of  record  is 
truncated  giving  variable  length  records  (length  is  deter¬ 
mined  by  number  of  data  items  actually  present). 

4.2  Default/State/Save  Files 

The  HACS  default  file  is  a  2489  word  external  disk  file  written  in  binary 
mode  from  internal  array  storage.  The  HACS  state  and  save  files  exist 
internally  in  HACS  common  areas  and  are  simply  arrays  for  data  storage. 

The  structure  and  data  organization  of  these  three  files  are  identical,  and 
contain  data  values  for  HACS  fields  at  different  stages  of  processing.  The 
default  file  is  used  to  initialize  the  HACS  state  file.  Field  data  values 
are  stored  in  the  HACS  state  file  according  to  the  attributes  or 
characterist ics  of  the  field,  and  these  characteristics  are  also  defined 
by  the  default  file. 

The  internal  representation  of  the  HACS  state  and  save  files  are  defined  by 
the  arrays  stored  in  the  common  area  /BASE/;  refer  to  the  listing  of 
program  HACS.  Using  the  elements  of  the  HACS  state  file  for  reference,  the 
structure  of  each  of  these  2489  word  files  is  as  follows: 
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Identification 

Length  (Words) 

Description 

MSG(10) 

10 

80-character  file  label 

MNF/MNI 

2 

Maximum  file  size  allocations 

MNF  =  maximum  number  of  real  data 
fields 

MN1  =  maximum  number  of  integer 
data  fields 

NF/NI 

2 

Actual  file  size  utilized 

NF  =  number  of  real  data  fields 
NI  =  number  of  integer  data 
fields 

L1ST( 275, 6) 

1650 

Contains  six  integer  words  of 
control  data  for  each  of  up  to  a 
maximum  of  275  data  fields  (see 
below) . 

FVAL(225, 3) 

675 

Contains  a  value,  minimum  limit 
and  maximum  limit  for  up  to  225 
real  data  fields 

IVAL( 50, 3) 

150 

Contains  a  value,  minimum  limit 
and  maximum  limit  for  up  to  50 
integer  data  fields 

2489  =  Total  file  length. 

Data  storage  and  retrieval  operations  from  these  files  are  governed  by  the 
contents  of  the  array  LIST(275,6),  referred  to  as  the  field  definition 
table.  The  first  entry  of  this  table  is  reserved  for  the  chemical 
recognition  code.  For  any  field  I,  the  entries  in  the  table  are: 

LIST(I,1)  *  Field  number 

L1ST(I,2)  =  Coded  field  specification  which  can  be  written 

in  BCD  form  as  C4-C3-C2-C1  where  the  characters 
Cl  to  C4  give  the  field  specifications  as 
follows : 

IVAR  *  C4,  specifies  the  field  value  data 

type  as  integer  (0)  or  real  (1) 

ITYP  =  C3-C2,  specifies  the  type  of  quantity 

governing  input/output  conversions  of 
the  field  value  as  a  two  digit  integer 
index  in  the  range  01  to  MTYP 
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ISRC  =  Cl 

,  specifies  the  source 

or  priority 

code  associated  with  the 

current  value 

of 

the  field,  coded  as: 

0 

missing 

1 

default 

2 

estimated  property 

3 

exact  property 

4 

computed  value 

5 

user  value 

6 

system  value 

-N 

LIST( I , 3) 

=  Up  to  twelve  character  field  name 

used  for 

LIST( 1,4) 

'  output  displays 

LIST(I, 5) 

LIST( 1,6) 

=  Index  to  entry  in  field  data  value  arrays. 

Gives  index 

to  array  IVAL  if  code  C4  (above)  is 

0,  or  to  array  FVAL  if  code  C4  is 

1 . 

During  a  normal  hazard  assessment  run,  the  only  file  items  that  are  changed 
as  a  result  of  user  and/or  computed  assessment  operations  are  MSG,  the 
source  code  Cl  of  the  field  definition  table,  and  data  values  stored  in 
array  positions  FVAL(I,1)  or  IVAL(I,1).  All  other  elements  of  the  state 
and  save  files  are  obtained  initially  from  the  default  file  and  cannot  be 
changed  during  any  assessment  run. 

The  various  save  and  recall  operations  performed  by  HACS  to  enter  data 
into,  or  read  data  from,  these  files  are  controlled  by  the  field  definition 
table,  requiring  the  coding  and  uncoding  of  LIST(I,2)  as  defined  below. 

(a)  Define  field  specification  -  given  pre-determined  values  of 
IVAR,  ITYP  and  ISRC  for  field  I,  the  field  specification  array 
element  is  coded  as: 

LIST( I , 2)  «  1000* IVAR+ 10* ITYP+ ISRC 

which  can  also  be  written  as: 

LIST( 1,2)  =  ISRC+10*( ITYP+100*IVAR) 

Also,  if  the  index  stored  in  the  last  entry  of  the  table  is  J  ■ 
LIST(I,6),  then  the  field  values  for  field  I  are  actually  stored 
in : 


if  IVAR  *  1 


FVAL(J,1)  *  value 
FVAL(J,2)  =  minimum  limit 
FVAL(J,3)  *  maximum  limit 


or,  if  IVAR  =  0 


IVAL( J , 1 ) 
IVAL( J , 2) 
IVAL(J , 3) 


value 

minimum  limit 
maximum  limit 


(b)  Update  source  code  -  to  change  the  source  code  specification  for 
the  value  of  field  I,  from  OLD  to  NEW,  the  field  specification 
array  element  is  manipulated  as  follows: 


LIST( I , 2)  =  L1ST(I,2)-0LD+NEW 


where  both  OLD  and  NEW  are  integer  variables. 

(c)  Read  field  specifications  -  given  an  existing  field  number,  the 
table  element  LIST(I,1)  is  searched  until  a  match  is  found,  and 
the  field  specification  array  element  is  uncoded  by  the  follow¬ 
ing  sc-  lence : 

IVAR  *  J.  1ST ( I,  2)/1000 
I SRC  -  1000* IVAR 
1TYP  (LIST(I,2)-ISRC)/10 
ISRC  =  LIST( I, 2)-10*ITYP-ISRC 

where  ISRC  is  also  used  for  intermediate  storage  of  the  product 
1000* IVAR. 


All  HAClj  database  operations  are  controlled  by  the  routines  IRCL,  ISV,  FRCL 
and  FSV  which  are  used  to  recall  or  save  integer  or  real  field  values. 
Calls  to  these  routines  are  issued  by  the  MACS  assessment  rate  models  and 
define  as  a  literal  in  the  calling  argument  list  the  field  number  to  be 
saved  or  recalled. 

Thus  the  definitions  of  field  numbers  and  field  data  types  (real,  integer) 
in  the  default  file  are  not  arbitrary  and  must  correspond  exactly  to  the 
definitions  established  by  the  HACS  program.  The  field  type  indicator, 
elements  C3  and  C2  of  LIST(I,2),  govern  unit  labeling  and  conversions  and 
are  not  generally  arbitrarily  defined. 

4.3  Data  Field  Explanations  (11) 

An  external  file,  unit  11,  is  used  to  store  text  descriptions  of  each  of  the 
data  item  fields  defined  in  the  HACS  state  file.  Individual  field 
descriptions  are  displayed  at  the  user  terminal  either  during  interactive 
user  input,  or  as  part  of  the  final  run  summary. 

The  user  reference  to  these  messages  is  controlled  either  by  the  UIM,  or, 
during  changes  to  the  model  input  sumnary,  by  the  user  entry  of  the  HACS 
data  item  field  number.  These  field  numbers  are  the  four  digit  integer 
reference  numbers  (1000  series,  2000  series,  3000  series  and  4000  series) 
defined  by  the  HACS  default  file  and  stored  in  the  HACS  state  file.  Within 
the  state  file,  the  data  fields  are  stored  sequentially,  and  the  present 
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version  of  HACS  contains  256  data  items.  Given  a  data  item  reference  by 
field  number,  the  HACS/UIM  uses  the  internal  state  file  for  reference  and 
obtains  a  message  index  number  (1  to  256)  from  the  sequential  position  of 
the  data  item  in  the  state  file.  Records  contained  in  the  data  field 
explanation  file  are  then  directly  accessed  by  keying  on  the  message 
sequence  number. 

Each  record  in  the  file  may  contain  from  3  to  690  characters  of  data,  and 
the  first  word  of  a  record  may  contain  a  code  for  different  types  of 
messages.  The  minimum  record  length  of  3  words  is  a  restriction  required 
for  Cybernet  processing  (shorter  records  are  padded  with  blank  fill). 
Messages  containing  less  than  690  characters  of  text  are  written  as 
variable  length  records. 

The  file  contains  four  types  of  messages: 

(1)  Uncoded  records  contain  text  which  is  displayed  at  the  user 
terminal . 

(2)  Type  1  records  contain  only  a  code  *  1  *  followed  by  blanks.  This 

code  is  automatically  translated  by  HACS/UIM  to  a  standard 

message  referencing  the  user  manual. 

(3)  Type  2  records  contain  only  a  code  '2'  followed  by  blanks.  This 

code  is  automatically  translated  by  HACS/UIM  to  a  standard 

message  referencing  CHRIS  Manual  II. 

(4)  Type  3  records  are  a  combination  of  uncoded  records  and  type  2 

records.  They  contain  the  code  3  followed  by  variable  length 
text.  In  HACS,  these  messages  provide  for  additional  explana¬ 
tion  or  clarification  of  particular  chemical  property  data 

items.  They  are  processed  by  first  displaying  the  message  from 
the  external  file,  followed  by  the  standard  type  2  CHRIS  Manual 
II  reference. 

The  message  file  is  created  using  separate  programs  described  in  Section  7 
of  this  report  which  insert  Fortran  format  codes  between  each  line  of  a 
message.  When  read  by  the  HACS/UIM,  appropriate  opening  and  closing  format 
characters  are  appended  to  the  message  text,  and  the  messages  are  displayed 
using  variable  format  output:  WRITE(6,TXT) . 

4,4  Scenario  Descriptions  (12) 

An  external  file,  unit  12,  is  used  to  store  text  descriptions  which  are 
used  to  produce  the  scenario  display  selected  by  user  option.  The  file 
contains  a  display  header  message,  scenario  descriptions  and  two  display 
trailer  messages. 

The  file  contains  31  variable  length,  uncoded,  text  messages,  each 
containing  up  to  690  characters  of  data.  Messages  1  to  28  give 
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descriptions  of  each  of  the  28  different  hazard  assessment  scenarios,  and 
the  messages  correspond  in  sequence  to  an  internal  list  of  scenario  codes 
contained  in  the  HACS/UIM.  Message  29  is  the  display  header,  and  messages 
30  and  31  give  the  display  trailer. 

The  message  file  is  produced  by  a  variation  of  the  program  used  to  create 
the  field  text  message  file  (refer  to  Section  7). 

The  records  contained  on  the  file  consist  of  character  strings  giving 
individual  lines  of  the  message,  each  string  separated  by  appropriate 
Fortran  format  control  characters.  These  control  characters  are  automa¬ 
tically  inserted  by  the  message  file  build  programs  (Section  7).  When  read 
by  the  HACS/UIM,  appropriate  opening  and  closing  format  characters  are 
appended  to  the  message  text,  and  the  messages  are  displayed  using  variable 
format  output:  WRITE(6,TXT) . 

4.5  Model  Descriptions  (13) 

An  external  file,  unit  13,  is  used  to  store  text  descriptions  which  are 
used  to  produce  model  explanations  selected  by  user  option.  The  file 
contains  29  messages,  one  for  each  model,  and  the  message  numbers 
correspond  in  sequence  to  an  internal  model  code  list  contained  in  the 
HACS/UIM. 

Each  message  is  variable  length,  uncoded,  and  contains  up  to  1900 
characters  of  data.  The  message  file  is  produced  by  a  variation  of  the 
program  used  to  create  the  field  text  message  file  (refer  to  Section  7). 

The  records  contained  on  the  file  consist  of  character  strings  giving 
individual  lines  of  the  message,  each  string  separated  by  appropriate 
Fortran  format  control  characters.  These  control  characters  are  automa¬ 
tically  inserted  by  the  message  file  build  programs.  When  read  by  the 
HACS/UIM,  appropriate  opening  and  closing  format  characters  are  appended 
to  the  message  text,  and  the  messages  are  displayed  using  variable  format 
output:  WRITE(6,TXT ) . 
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5.  HACS/UIM  PROGRAM  LISTINGS 


This  section  gives  complete  listings  of  all  programs  and  subroutines 
comprising  the  HACS/UIM  installed  on  CDC's  Cybernet  as  of  20  April  1981, 
and  may  be  subject  to  change  based  on  the  results  of  subsequent  work. 

The  listings  are  given  in  the  sequence  in  which  the  HACS  overlay  program 
files  were  established;  programs  and  routines  within  overlay  0  are 
followed  by  programs  within  overlay  1  and  so  forth. 

Generally,  the  listing  of  each  routine  provides  a  description  of  the 
overall  function  and  method  of  operation  of  the  routine,  definitions  of 
variables  used,  and  commented  processing  sequences.  File  and  data  element 
structures  are  defined  where  primary  references  occur.  In  addition,  the 
main  program  of  the  base  overlay,  PROGRAM  HACS,  and  subroutine  PROP  of 
overlay  1  contain  complete  definitions  of  all  common  variables  used. 


uuuuuuuuuuuauuaouuuuuuuuuuuuuuu  uuuuuu  uuuuuuuuuuuuuuuuuuuuuuuu 


0VFRLAY<UIMABS,0,0> 

PROGRAM  HACS< INPUT , OUTPUT, TAPF5=INPIIT»TAPE630UTPUT ,TAPE9,TAPE10, 
1TAPE60* INPUT, TAPE 61 “OUTPUT » TAPEll >TAPF12»TAPE13) 

PROGRAM  HACS  PROVIDES  THE  OVERALL  CONTROLLING  FRAMEWORK 
EXECUTING  THE  HACS  INPUT  DATA  PROCESSOR,  SELECTED  HAZARD 
ASSESSMENT  RATE  MODELS  AND  THE  OFF-LINE  PLOTTED  OUTPUT  POST¬ 
PROCESSOR.  THE  CONTROLLING  LOOP  CYCLES  UNTIL  EITHER  A  FATAI 
ERROR  IS  DETECTED  IN  THE  INPUT  DATA,  OR  AN  END  OF  FILE  IS 
REACHED,  ALL  OVERLAYS  ARE  RESTORED  AS  REQUIRED  BY  CALLS  TO 

SUBROUTINE  OVLOD.  ERROR  EXIT  MODE  IS  TURNED  ON  BY  COMPASS 
ROUTINE  *ERR*.  THIS  ROUTINE  WILL  TRAP  ALL  EXECUTION  ERRORS 
TO  A  SUBROUTINE  ECHCK  WHERE  A  MESSAGE  WILL  BE  OUTPUT 
INDICATING  THE  ERROR  AND  THE  OVFRLAY  IN  WHICH  IT  OCCURRED. 
EXECUTION  IS  THEN  TERMINATED. 

FBLNK  “  DATA  WORD  SET  TO  ALL  BLANKS  (A8>  USED  TO  INITIALIZE 
THE  OUTPUT  PAGE  TITLE 
I  =  DUMMY  FORTRAN  INDEX 

COMMON  VARIABLES  USED  -  ANG» DATE, EOF , IFRST »LNCT ,LP, MODEL rMODNO, 

NOFF, NOP , NPG , OVLST , PLTYP , STCON , SVCON , 
TITLE 

SUBROUTINES  REQUIRED  -  DYYR,FCHCK,LSTFL, OVLOD, PAGER, TRACE 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL,  617-864-5770  EXT.  2813 
DATE  -  19  FEBRUARY  1976 

COMMON/OVER/NOV, SEG 


OVERLAY  NUMBER  CORRESPONDING  TO  ASSESSMENT  RATE  MODEL 
SECONDARY  OVERLAY  NUMBER  LOADED  IN  CORE 


OCOMMON/BASE/SAVE ( 2489) , UPTH( 15 ) , MSG  < 10 ) » MNF » MNI , 

1  NF  »NI »LIST  <  775 , 6 ) , FVAL( 225 , 3 ) » I VAL(50 , 3 ) 

INTEGER  UPTH 

REAL  MSG 

DIMENSION  STATE(248?) 

EQUIVALENCE  (STATE! 1 ) ,MSG( 1 ) ) 


SAVE  =  HACS  SAVE  FILE,  CONTAINS  SAVED  DATA  BASE  IN  SAME 
FILE  STRUCTURE  AS  HACS  STATE  FILE 
UPTH  =  CONTAINS  CURRENT  VALUES  OF  PATH  CODES  AS  READ  FROM 
USER  INPUT  AND  STORED  LEFT  JUSTIFIED  IN  UP  TO  15 
INTEGER  WORDS  <A1  FORMAT) 

STATE  =  HACS  STATE  FILE  CONTAINING  ELEMENTS  AND  STRUCTURED 
AS  DEFINED  BY  THE  REMAINDER  OF  THIS  SECTION  - 
MSG  =  A  10  WORD  REAL  ARRAY  GIVING  AN  80  CHARACTER  HACS 
FILE  LABEL.  CONTFNTS  ARE  COPIED  FROM  THE  USER 
INPUT  TITLE  CARD.  FOR  CREATING  AND  UPDATING  HACS 
DEFAULT  FILES,  THIS  TEXT  SHOULD  INCLUDE  THE  NAME’S’ 
OF  THE  AUTHOR  OF  THE  FILE  AND  DATE  OF  PREPARATION 
MNF  =  MAXIMUM  ALLOWABLE  NUMBER  OF  REAL  FIELD  VALUES, 
EQUIVALENT  TO  DIMFNSION  OF  ARRAY  FVAL 
MNI  =  MAXIMUM  ALLOWABLE  NUMBER  OF  INTFGER  FIELD  VALUES, 
EQUIVALENT  TO  DIMENSION  OF  ARRAY  TVAL 
NF  =  CURRENT  NUMBER  OF  REAL  FIELD  VALUES  ACTUALLY  STORED 
STORED  IN  FILE  ARRAY  FVAL 

NI  “  CURRENT  NUMBER  OF  INTEGER  FIELD  VALUES  ACTUALLY 
STORED  IN  FILE  ARRAY  IVAL 

LIST  =  FIELD  DEFINITION  TABLE  DIMENSIONED  AS  LIST (MFLD,6> 

WHERE  MFLD*MNI4MNF .  NUMBER  OF  DEFINITIONS  ACTUALLY 
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STORED  IS  GIVEN  BY  NFLD=NI+NF .  FIRST  FIELD 
DEFINITION  IS  RESERVED  FOR  CHEMICAL  RECOGNITION 
CODE  -  SEE  NOTE  BELOW.  FOR  ANY  FIELD  If  THE 
ELEMENTS  OF  LIST  ARE  DEFINED  AS  FOLLOWS  - 


LIST! I » 1 > 
LIST ( I f2) 


LIST (1,3) 
LIST (1,4) 
LIST (If  5) 
LIST ( I f 6) 


IVAL(Jfl)  = 


IVAL(Jt2) 
IVAL( Jt 3) 
FVAL(Jfl) 
FVALU.2) 
FVAL( Jf 3) 


FIELD  NUMBER 

CODFD  FIELD  SPECIFICATION  STORED  IN  A 
FOUR  DIGIT  INTEGER  FORMAT  C4-C3-C2-C1 
WHERE  - 

C4  =  INDICATOR  FOR  INTEGER  (0) 

OR  REAL  (1)  FIELD  VALUE 

C3-C2  =  TUO  DIGIT  INTEGER  TYPE 
CODE  IN  RANGE  01  TO 
MTYP  DEFINING  TYPE  OF 
PHYSICAL  RUANTITY » 

ALSO  USED  AS  INDEX- 
CONTROLLING  UNITS 
CONVERSION 

Cl  =  FIELD  VALUE  SOURCE  CODE 

0  =  MISSING 

1  =  DEFAULT 

2  =  ESTIMATED  PROPERTY 

3  =  EXACT  PROPERTY 

4  =  COMPUTED  VALUE 

5  =  USER  VALUE 

6  =  SYSTEM  VALUE 

ONE  TO  TWELVE  CHARACTER  FIELD  NAME 
USED  FOR  OUTPUT  DISPLAYSf  AND 
STORED  IN  WORDS  3f4  AND  5  OF  LIST 
INTEGER  POINTER.  INDEX.  TO  ARRAYS  FOR 
ACTUAL  FIELD  VALUE.  AND  MINIMUM  AND 
MAXIMUM  VALUE.  POINTS  TC  ARRAY  IVAL 
IF  CODE  C4  (ABOVE)  IS  0.  OR  TO  ARRAY 
FVAL  IF  CODE  C4  IS  1. 

VALUE  OF  INTEGER  FIELD,  LINKED  TO  FIELD 
NUMBER  IN  LIST(I.l)  BY  INDEX  IN 
LIST (1,6).  AND  CODE  C4  IN  LIST (1.2) 
MINIMUM  VALUE  OF  INTEGER  FIELD 
MAXIMUM  VALUE  OF  INTEGER  FIELD 
VALUE  OF  REAL  FIELD,  SEE  IVAL(J.l) 
MINIMUM  VALUE  OF  REAL  FIELD 
MAXIMUM  VALUE  OF  REAL  FIELD 


COMMON/C/PLTYP » XBX ( 150) 
INTEGER  PLTYP 


PLTYP  =  INTEGER  CODE  SET  BY  HACS  RATE  MODEL  TO  SELECT  LOGIC 
FOR  PRODUCING  OFF-LINE  PLOT  TAPE  FILE 
XBX  =  ARRAY  USED  TO  PASS  OFF-LINE  PLOT  DATA  FROM  RATE 

MODELS  TO  PLOT  LOGIC.  DATA  IS  AVAILABLE  IN  XBX 
ONLY  IMMEDIATELY  FOLLOWING  EXECUTION  OF  PATE 
MODEL  AND  IS  OVERWRITTEN  BY  EXECUTION  OF  NEXT 
RATE  MODEL.  EXCESS  SPACE  IN  XBX  IS  ALSO  USED 
FOR  STORAGE  OF  ADDITIONAL  DATA  ARRAYS  USED  BY 
RATE  MODELS. 

OCOMMON/CNTRL/EOFF , ICD, IDFLT»LBL(4) »LSTCN(3,3> , MODEL ( 15) »NQP» 

1  STCON.SVCON 

INTEGER  EOFF, STCON.SVCON 

REAL  LBL 


EOFF  =  INDICATOR  SET  TO  -1  IF  A  SET  OF  USER  DATA  CARDS  HAS 
BEEN  TERMINATED  BY  AN  END  OF  FILE,  0  OTHERWISE. 

ICD  =  CHEMICAL  RECOGNITION  CODE  (A4)  READ  AS  USER  DATA 
IDFLT  =  FORTRAN  UNIT  NUMBER  FOR  EXTERNAL  STORAGE  OF  HACS 

DEFAULT  DATA  FILE  MANIPULATED  BY  SUBROUTINE  ACCESS 
LBL  *  FOUR  WORD  ARRAY  OF  LABELS  DESCRIBING  TYPE  OF  HACS 
STATE  OR  SAVE  FILES  (1=EMPTY ,  2*DEFAUU •  3=USER, 
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4=C0MPUTED> 

LSTCN  =  ARRAY  USED  TO  STORE  VALIDATED  FILE  DISPLAY  OPTIONS 
BY  REFERENCE  NUMBER  FOR  USE  IN  SUBROUTINE  LSTFL 
MODEL  *  ARRAY  OF  INTEGER  RATE  MODEL  INDICES  CORRESPONDING 
TO  USER  SPECIFIED  PATH  CODE  LETTERS 
NOP  =  HACS  OPERATION  CONTROL  VARIABLE  DETERMINED  FROM  USER 
INPUT  AS  -  1  =  RUN 

2  =  RE-RUN 

3  =  CONTINUE 

4  =  LOAD  DEFAULT 

5  =  UPDATE  DEFAULT 

STCON  =  INTEGER  CONTROL  FOR  TYPE  OF  VALUES  IN  HACS  STATE 
FILE  (REFER  TO  DEFINITION  OF  ARRAY  LBL ) 

SVCON  =  INTEGER  CONTROL  FOR  TYPE  OF  VALUES  IN  HACS  SAVE 
FILE  (REFER  TO  DEFINITION  OF  ARRAY  LBL) 

C0MM0N/CNVDT/C0NV(3f 47) »MSYS,MTYP»UNIT(4,47) 

CONV  =  ARRAY  OF  CONVERSION  FACTORS  STORED  AS  CONV( JSYS, ITYP) 
FOR  EACH  DEFINED  TYPE  (ITYP)  OF  PHYSICAL  QUANTITY. 
THE  SYSTEM  INDEX  .JSYS  1.  2,  3  CORRESPONDS  TO 
UNIT  LABEL  INDICES  ISYS  =  2,  3,  4  SINCE  CONVERSION 
FACTORS  ARE  NOT  STORED  FOR  INTERNAL  HACS  UNITS. 
CONVERSION  FACTORS  ARE  APPLIED  AS  FOLLOWS  - 
(INTERNAL  VALUE)  =  (INPUT  VALUE)  *  CONV 
EXCEPT  FOR  TEMPERATURE  CONVERSIONS  WHICH  ARE  CON¬ 
TROLLED  BY  BRANCHING  ON  ITYP. 

MSYS  =  MAXIMUM  NUMBER  OF  DEFINED  SYSTEMS  OF  UNITS 

MTYP  =  MAXIMUM  NUMBER  OF  TYPES  OF  PHYSICAL  QUANTITIES 

UNIT  =  ARRAY  OF  FIELD  VALUE  UNIT  LABELS  (A8)  STORED  AS 

UNIT ( ISYS. ITYP)  FOR  EACH  DEFINED  TYPE  (ITYP)  OF 
PHYSICAL  QUANTITY  AND  SYSTEM  OF  UNITS  (ISYS).  UNIT 
LABELS  AND  CONVERSION  FACTORS  ARE  DEFINED  FOR  BOTH 
REAL  AND  INTEGER  FIELDS.  HOWEVER.  NUMERIC 
CONVERSIONS  ARE  APPLIED  ONLY  TO  REAL  FIELDS.  CON¬ 
VERSIONS  FOR  ANY  TYPE  QUANTITY  MAY  BE  SUPPRESSED 
BY  LEAVING  THE  APPROPRIATE  DATA  WORD  IN  UNIT  BLANK. 
ALL  UNITS  HOWEVER  MUST  BE  GIVEN  FOR  SYSTEM  1  WHICH 
SPECIFIES  INTERNAL  UNITS.  ON  INPUT,  DATA  READ  WITH 
A  BLANK  UNIT  FIELD  IS  ASSUMED  TO  BE  IN  INTERNAL 
UNITS.  ON  OUTPUT,  VALUES  ARE  DISPLAYED  IN  ALL 
DIFFERENT  NON-BLANK  UNITS  SPECIFIED. 

COMMON/HEAD/DTE, LNCT,LNPG,LP,NPG,TITLF( 10) 

DTE  =  DATE  OF  PROGRAM  EXECUTION  DETERMINED  AT  TIME 
LNCT  =  COUNT  OF  LINES  PRINTED  ON  CURRF *T  LINE  PAGE 

LNPG  =  MAXIMUM  NUMBER  OF  LINES  PER  L|V(:  PRINTER  PAb£ 

LP  =  FORTRAN  UNIT  NUMBER  FOR  LINE  PRINTER 

NPG  =  LINE  PRINTER  PAGE  NUMBER 

TITLE  =  80  CHARACTER  USER  INPUT  RUN  TITLE  DISPLAYED  AT  THE 

TOP  OF  EACH  OUTPUT  PAGE. 

COMMON/IOCNT/ICVSL , IPRAC » IPRRP.NOFF , NPRRP 


ICVSL 


IPRAC 

IPRRP 


OUTPUT  UNIT  SELECTION  OPTION  RECALLED  FROM  HACS 
STATE  FILE.  VALUE  IS  0  FOR  ALL,  OTHERWISE  IS 
SYSTEM  NUMBER  <1=CGS.  2=SI,  3=ENG ,  4=MXD) 

CONTROL  OPTION  TO  SUPPRESS  (0)  OR  TO  SELECT  (1) 
ACCESS  TO  THE  HACS  PHYSICAL  PROPERTY  DATA  TAPE 
CONTROL  OPTION  TO  SUPPRESS  (0)  OR  TO  SELECT  (1) 
OUTPUT  AUDIT  OF  HACS  PHYSICAL  PROPERTIES  IF  READ 
FROM  PROPERTY  TAPE 

CONTROL  OPTION  TO  SUPPRESS  (0)  OR  TO  SELECT  (1) 
PRODUCTION  OF  DATA  TAPE  FOR  OFF-LINE  PLOTTING. 

IF  SELECTED,  DATA  IS  ACTUALLY  GENERATED  ONLY  IF 
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CERTAIN  RATE  MODELS  ARE  EXECUTED  AND  THE  USER  HAS 
REQUESTED  PLOTTED  OUTPUT  OPTIONS  FOR  THESE  MODELS. 
NPRRP  =  INTEGER  SWITCH  USED  IN  DATA  BASE  SAVE  AND  RECALl 
ROUTINES  (FCNV  ONLY)  TO  SELECT  OPTIONAL  GUTPUT 
DURING  PROPERTY  FILE  INTERFACE 

COMMON /M0DCN/M0DEX( 29) »M0DI0tL0CI0 

COMMON/NAME/PTLST ( 30) » SOURC  <  7 ) 

INTEGER  PTLST 


PTLST  =  DATA  LIST  OF  ALL  PATH  CODES  RECOGNIZED  BY  HACSt  A  TO 
Z.  II»  RRf  SS  AND  BLANK f  EACH  STORED  LEFT  JUSTIFIED 
IN  AN  INTEGER  WORD  (A1  FORMAT).  THE  SEQUENCE  IN 
WHICH  THE  PATH  CODES  ARE  STORED  IS  USED  TO  VERIFY 
THE  SEQUENCE  OF  PATH  CODES  SPECIFIED  BY  the  'JSFR. 
E.G..  MODEL  A  MUST  BE  EXECUTED  BEFORE  MODEL  B  IF 
BOTH  ARE  SPECIFIED. 

SOURC  =  ARRAY  OF  LABELS  DEFINING  SOURCE  CODES  FOR  FIELD  VALUE 
DISPLAYS.  LABELS  ARE  STORED  IN  AN  ARRAY  INDEXED 
FROM  1  TO  7»  CORRESPONDING  TO  SOURCE  CODES  INDEXED 
FROM  0  TO  6 


COMMON/OVCNT/MODNOf OVLST  <  29 ) iSGLST (29) 
INTEGER  OVLSTfSGLST 


MODNO  =  INTEGER  INDEX  FOR  NEXT  RATE  MODEL  TO  BE  EXECUTED? 

CORRESPONDS  TO  POSITION  OF  PATH  CODE  LETTER  IN 
ARRAY  PTLST  AND  HAS  VALUES  FROM  1  TO  30 
OVLST  =  SPECIFIED  OVERLAY  NUMBER  CONTAINING  CODE  FOR  ALL 

VALID  RATE  MODELS  AS  OVLST(MODNO)  WHERE  MODNO  IS 
IN  RANGE  1  TO  29 

SGLST  =  SPECIFIES  SEGMENT  NUMBER  WITHIN  OVERLAY  FOR  MODEL  AS 
SGLST( MODNO)  WHERE  MODNO  IS  IN  RANGE  1  TO  29,  A 
VALUE  OF  0  IS  STORED  FOR  ALL  UNDEFINED  SEGMENTS , 


COMMON/PLTCN/ANGi IBUF ( AOOO) » IFRST r IPLT? WIND 


ANG  =  SPECIFIES  WIND  DIRECTION  FROM  NORTH  FOR  USE  IN  OUTPUT 
LABEL  ON  OFF-LINE  PLOT  (NO  LONGER  IN  USE).  VALUE 
OF  0.0  IS  USED  INSTEAD  TO  SUPPRESS  COMPASS  LABEL. 
IBUF  =  ARRAY  USED  BY  OFF-LINE  PLOT  ROUTINES  AS  A  WORK  AREA 
FOR  BUILDING  TAPE  RECORDS 
IFRST  =  CONTROL  SWITCH  SET  TO  ONE  TO  EXECUTE  PLOT 

INITIALIZATION  ROUTINES  ON  FIRST  PASS  ONLY, 

IPLT  =  FILE  NAME  USED  FOR  PLOT  TAPE 

WIND  *  WIND  VELOCITY  OBTAINED  FROM  HACS  DATA  FIELD  2016 


EXTERNAL  FCHCK 
INTEGER  FLDTAB(257) 

INTEGER  SCNTAB(32) 

INTEGER  M0DTAB(30) 

LOGICAL  YESNO 
INTEGER  ERRAY ( 6 ) 

DATA  ERRAY/6*f-0)/fERRAY(A)/0/ 
DATA  FBLNK/10H  / 


- INITIALIZE  VARIABLES  IN  COMMON  STORAGE  FOR  RE-EXECUTION 

CALL  OPENMSdliFLDTABr 257r 0) 

CALL  OPENMS( 12iSCNTAB?32?0> 

CALL  QPENMS( 13? N0DTAB?30fO' 

REWIND  10 
CALL  TRACE(OfOiO) 

NOV  =  0 
SEG  =  0 
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CALL  ERR(FCHCK) 

CALL  SYSTEMC<115*ERRAY) 

ANG=0.0 

E0FF=0 

IFRST=1 

PLTYP=0 

STC0N=1 

SUCON-1 

C 

C - INITIALIZE  OUTPUT  PAGING  ROUTINE 

CALL  DATE(DTE) 

CALL  TIME(TIM) 

URITE<6*1020)  DTE « TIM 

10200F0RMAT (//5X*33HHAZARD  ASSESSMENT  COMPUTER  SYSTEM/ 
1  5X.21HEXECUTI0N  STARTED  ON  *A10*4H  AT  *A9//> 
LNCT=0 
NPG=0 

DO  5  1=1*10 

5  TITLE ( I )=FBLNK 
DO  6  1=1*29 

6  MODEX ( I )  —  0 
CALL  PAGER(5) 

L0CI0=2 


- RETURN  HERE  TO  ACCESS  HACS  DATA  INPUT  PROCESSOR,  INITIAL  CALL 

TO  FAULT  CHECK  ROUTINE  INITIALIZES  ERROR  INDICATORS  BEFORE 
ENTERING  OVERLAY.  INPUT  PROCESSOR  RETURNS  NOP  =  C  TO  TERMINATE 
OR  NOP  =  1*2  OR  3  TO  EXECUTE  ASSESSMENT  RUN. 

10  CALL  OVLOD(l) 


- SKIP  TO  END  IF  USER  OPTION  CANCELLED*  OR  DOES  NOT  REQUIRE 

EXECUTION  OF  RATE  MODELS 
IF(NOF.EQ.O)  GO  TO  40 


. —LOOP  ON  RATE  MODEL  INDICES  OBTAINED  FROM  USER  PATH  CODE 

INPUT  UNTIL  INDEX  CORRESPONDING  TO  FIRST  BLANK  IS  FOUND, 
EXECUTE  OVERLAY  FOR  EACH  MODEL. 

DO  20  1=1*15 
MODNO=MQDEL< I ) 

IF < MODNO .GE , 30 )  GO  TO  30 
NOV=OVLST (MODNO) 

IF (NOV.EQ.O)  GO  TO  20 
15  M0DIO=MQDEX( MODNO) 

CALL  OVLGD<NOV) 

M0DEX(M0DN0)=1 

STC0N=4 


. —TEST  FOR  SELECTION  OF  OFF-LINE  PLOTTED  OUTPUT 

IF(NOFF.EQ.O)  GO  TO  20 
IF (PLTYP.EQ.O)  GO  TO  20 

- EXECUTE  OFF-LINE  PLOTTED  OUTPUT  POST-PROCESSOR 

NOV  =  2 
CALL  0VL0DI2) 

CALL  PAGER (3) 

URITE(LP  *  1010) 

WRITE(LP* 1030) 

IF (YESNO(O) )  GO  TO  15 

1030  FORMAT  (34H  DO  YOU  WANT  TO  RE-RUN  THIS  NODEL7) 

20  CONTINUE 

. TEST  FOR  FILE  DISPLAY  OPTION  AFTER  MODEL  EXECUTION 

30  CALL  LSTFL<3) 

CALL  SUMRY 

- RETURN  TO  INPUT  DATA  PROCESSOR  IF  AN  END  OF  FILE  HAS  NOT 

YET  BEEN  ENCOUNTERED*  OTHERWISE  TERMINATE  RUN. 

IF (EOFF ,EQ*0)  GO  TO  10 
C 

C . END  OF  RUN 

40  CALL  PAGER(5) 

WRITEILP* 1000) 
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nnnnnnnnnnnnn  nooooo 


60  TO  50 


1000  FORMAT  (//5X. 15( 1H*)/5X. 15HEND  OF  HACS  RUN/5X. 15( 1H«) ) 

10100F0RMAT  <//54H  MODEL  OUTPUT  WAS  WRITTEN  TO  TAPE  FOR  OFFLINE  PLOTTIN 
1G) 

50  CALL  TRACE(l.O.O) 

END 

SUBROUTINE  BEGPR(NAME) 

THIS  SUBROUTINE  PRINTS  A  MESSAGE  THAT  INDICATES  A  RATE 
MODEL  IS  BFING  EXECUTED 

SUBROUTINES  REQUIRED  -  PAGER 

C0MM0N/H0DCN/M0DEX(29) » MODI  0 ? LOCI 0 
CALL  PAGER (0) 

CALL  PAG£R<1> 

WRITE(6.1000>  NAME 
CALL  PAGER(3) 

IF(LOCIO.EQ,20)  GO  TO  10 
IF(MODIO.NE.O)  GO  TO  20 
L0C10=1 
WRITE(6.1010) 

RETURN 
10  L0CI0=2 
20  WRITE(6»1020) 

RETURN 

1000  FORMAT  (23H  FOR  EXECUTION  OF  MODEL* A4* 1H* ) 

10100F0RMAT  (66H  PREVIOUSLY  UNSPECIFIED  INPUT  DATA*  IF  ANY*  ARE  REQUEST 
1ED  BELOW...//) 

1020  FORMAT  (37H  THE  SUMMARY  OF  INPUT  DATA  FOLLOUS. . .//) 

END 

BLOCK  DATA 

SUBPROGRAM  GIVES  INITIAL  OR  DATA  VALUES  FOR  ALL  VARIABLES 
DEFINED  IN  LABELLED  COMMON.  REFER  TO  MAIN  PROGRAM  FOR 
DEFINITIONS  OF  EACH  VARIABLE. 

AUTHOR  -  R.G.  POTTS*  ARTHUR  D.  LITTLE*  INC.* 

35/309A  ACORN  PARK* 

CAMBRIDGE*  MASS.*  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  29  JANUARY  1976 

OCOMMON/BASE/MSGS( 10 )*MNFS*MNIS*NFS*NIS*LISTS( 275»6>. 

1  FVALS<  225*3) * IVALS(50.3) *  DPTH  < 15 ) *MSG( 10) *MNF*MNI * 

2  NF.NI*LIST<275.6)*FVAL(225*3)*IVAL(50*3) 

INTEGER  UPTH 

REAL  MSGS* MSG 

DIMENSION  SAVE (2489) .STATE (2489) 

EQUIVALENCE  (SAVE( 1 ) *MSGS< 1 ) ) * ( STATE ( 1 >  *MSG< 1 ) ) 

OCOMMON/CNTRL/EOFF  * ICD* IDFLT*LBL(4) *LSTCN(3*3) *MODEL( 15) .NOP* 

1  STCON.SVCON 

INTEGER  EOFF. STCON.SVCON 

REAL  LBL 

C0MM0N/CNVDT/C0NV(3.47).MSYS.MTYP*UNIT(4.47) 

COMMON/HEAD/DTE. LNCT.LNPG.LP.NPG.TITLE( 10) 

C0MM0N/NAME/PTLST(30) *S0URC(7) 

INTEGER  PTLST 

COMMON/OVCNT /MODNO . OVLST ( 29 ) . SGLST ( 29 ) 

INTEGER  OVLST. SGLST 

COMMON/PLTCN/ANG. IBUF (4000 ) . IFRST . IPLT . WIND 
0C0MM0N/INTER/BLANK*BUFF(80). CHAR.IN.NO. 

1  NUM.OUT .PTR.SPLST (14) .TYP.YES 


i 


I 


oo no on  non  ooo  o oo  ooo  noon 


INTEGER  BLANK, BUFF r CHAR t DEC f EXP 
INTEGER  OUT ,PLUS,PTR»SPLST »TYP» YES 
DATA  BLANK/1H  /, IN/5/, N0/1HN/ , OUT/6/ , YES/1HY/ 
ODATA  (SPLST (I)»I*1»14)/1H0»1HI,1H2,1H3»1H4, 

1  1H5»1H6»1H7,1H8, 1H9, 1H+, 1H-, 1H. , 1HE/ 


- IDENTIFY  PLOT  OUTPUT  FILE 

DATA  IPLT/4LIPLT/ 

- INITIALIZE  SAVE  FILE 

ODATA  < MSGS (I) »I=1»10)/10*10H  /,MNFS/225/»KNIS/50/»NFS/0/, 

1  NIS/l/,LISTS<l>l)/1001/,LISTS(i,2)/460/»<LISTS<l,I),T-3,5) 

2  /3*4H  /*LISTS< 1 »6)/l/> IVALS( 1 » 1 >/4H  /»IVALS(1»2) 

3  /4HN/A  / » I V ALS (1,3)/ 4HN/A  / 

- INITIALIZE  STATE  FILE 

ODATA  (MSG(I),I=1,10>/10*10H  /,MNF/?25/,MNI/S0/,NF/0/, 

1  NI/1/»LIST( 1 , 1 )/1001/,LIST( 1 »2>/460/ » (LIST( 1  *  I ) » 1=3*5) /3* 

2  4H  /*LIST( 1 ,6)/l/» IVAl ( 1  *  1 )/4H  /,IVAL( 1 ,2>/4HN/A  /, 

3  !UALU.’3>/4HN/A  / 

- INITIALIZE  PATH  CODE  INPUT  ARRAY 

DATA  (UPTHd),I  =  l,15)/15*4H  / 

- INITIALIZE  AND  SET  DATA  FOR  OPERATIONS  CONTROL 

ODATA  EOFF/O/ *IDFLT/10/*LBL(1)/8H  EMPTY  /,LBL(2)/8HDEFAULT  /, 

1  LBL(3)/8H  USER  /*LBL(4)/8HC0MPUTED/*STC0N/t/,SVC0N/l/ 

- SET  DATA  FOR  UNIT  CONVERSIONS.  NOTE  THAT  ADDITIONAL  DATA  IS 

DEFINED  AS  NECESSARY  IN  SUBROUTINES  FOR  USE  IN  CONVERTING 
TEMPERATURE  VALUES  (TYPE  06).  ALL  OTHER  CONVERSIONS  ARE 
APPLIED  AS  SCALE  FACTORS. 

DATA  MSYS/4/ »MTYP/47/ 

C 

ODATA 


1 

(C0NV< I , 

1> 

»I=1.3)/1,0 

,1.0 

,1.0 

/, 

2 

(conv(i» 

2) 

» I=l,3)/100. 

,30.48 

,160900.0 

/, 

3 

( CONV ( I > 

3) 

»I=1»3)/1000000.0 

,28317.0 

,3786.09 

/, 

4 

(C0NV( I » 

4) 

»I=1»3)/0.001 

,0.01602 

,1.0 

/, 

5 

(C0NV(I, 

5) 

»I®1»3)/10.0 

,68950.0 

,1333.0 

/, 

6 

( CON V  < I , 

6) 

.I-l.3)/273,l5 

,32.0 

,273.15 

/, 

7 

(C0NV< I , 

7) 

.1=1 »3)/10000.0 

,929.0304 

,10000.0 

/, 

8 

(C0NV( I » 

8) 

»I=1»3)/1000.0 

,453.6 

.907200.0 

/, 

9 

(CONva. 

9) 

.1=1. 3)/0. 0002389 

,1.0 

,1.0 

/ 

ODATA 

1 

(C0NV(I. 

10) 

.1=1, 3)/0. 0002389 

,0.55556 

,0.0002389 

/, 

2 

<  CONV ( I » 

11) 

» 1=1 ,3) /1 .0 

,60.0 

,3600.0 

/, 

3 

(CONVd , 

12) 

»I=1,3)/1000.0 

,453.6 

,252.0 

/» 

4 

(CONV (I » 

13) 

»I=l»3)/l,0 

,0.01745 

,0.01745 

/, 

5 

(CONVd , 

14) 

.1=1, 3)/0. 00002389 

,0.0000753 

,0.00002778 

/, 

6 

(C0NV(I» 

15) 

»I=1,3)/100.0 

,44.7 

,51.44 

/, 

7 

(CONVd. 

16) 

, 1=1 »3)/l .0 

,1.0 

,1.0 

/, 

8 

(CONVd. 

17) 

,1=1, 3)/0. 002389 

,0.004134 

,0.002778 

/  7 

9 

(CONVd. 

18) 

» 1=1 »3)/1000.0 

,453.6 

,1000.0 

/ 

ODATA 

1 

(CONVd. 

19) 

»I*1»3)/10000.0 

,929.0304 

,10000.0 

/, 

2 

(CONVd. 

20) 

, 1*1 »3)/l ,0 

,0.01667 

,0.0002778 

/, 

3 

(CONVd. 

21) 

,1  =  1 ,3)/l  .0 

,1.0 

,1.0 

/, 

4 

(CONVd. 

22) 

,I=1,3>/10. 

,0.01 

,0.01 

/, 

5 

(C0NV(I. 

23) 

, 1=1 ,3)/l . 0 

,1.0 

,1.0 

/, 

6 

(CONVd. 

24) 

»I=1»3)/1.0 

,1.0 

,1.0 

/, 

7 

(CONVd. 

25) 

»I«l, 31/0.1 

,0.4883 

,0.1 

/, 

8 

(C0NV(I. 

26) 

» 1*1 »3)/l ,0 

,1.0 

,1.0 

/, 

25 


' 

9 

(CONVd* 

27) 

*1=1 *3)/l .0 

*1.0 

*0.001  / 

L 

ODATA 

j 

1 

(CONVd, 

28) 

> 1=1 ,3)/0. 0002389 

,1.0 

*1.0 

7, 

» 

2 

(CONVd  * 

29) 

, 1=1 , 3) /l . 0 

,1.0 

*1.0 

/, 

i 

3 

(CONVd* 

30) 

» 1=1 ,3)/l .0 

,1.0 

*1.0 

7* 

j 

4 

(CONVd' 

31) 

, 1=1 ,3)/l • 0 

*1.0 

*1.0 

7* 

5 

( CONVd  i 

32) 

*  1  =  1 *3>/l . 0 

*1.0 

*1.0 

/* 

j 

6 

(CONVd* 

33) 

, 1  =  1 ,3  >/l *0 

*1.0 

*1.0 

/* 

3 

7 

(CONVd' 

34) 

, I=l*3)/1 .0 

*1.0 

*1.0 

/, 

8 

(CONVd' 

35) 

*  1  =  1 , 3 ) / 1  *  0 

*1.0 

,1.0 

/* 

't 

9 

(CONVd' 

36) 

*I=1*3)/1.0 

,1.0 

.1.0 

7 

\ 

L 

ODATA 

! 

1 

(CONVd. 

37) 

,I=1*3)/1.0 

*1.0 

*1.0 

/, 

| 

2 

(CONVd' 

38) 

*  1  =  1  *  3 )/l .0 

*1.0 

*1.0 

7* 

I 

3 

(CONVd' 

39) 

,1=1,3)71.0 

*1.0 

*1.0 

/, 

4 

(CONVd' 

40) 

*  1  =  1 ,3)71.0 

*1.0 

,1.0 

/* 

5 

(CONVd* 

41) 

*I=1,3)/1.0 

,1.0 

*1.0 

/* 

6 

(CONVd* 

42) 

*  1  =  1 *3)/l»0 

*1.0 

*  1 1 0 

/, 

\ 

7 

(CONVd* 

43) 

*  1*1 , 3 )/l .0 

*1.0 

,1.0 

7* 

1 

8 

(CONVd* 

44) 

*1=1*3) /0.0075 

,51.725 

*0.00075  /* 

p 

9 

(CONVd* 

45) 

, 1=1 » 3)710.0 

*68950.0 

,10000000.0  / 

ODATA 

1 

(CONVd* 

46) 

,1=1*3) 7 1.0 

*1.0 

*1.0 

/. 

2 

(CONVd* 

47) 

*1=1,3)7100.0 

*0.042333  *  0 . OC 1667  7 

L 

ODATA 

1 

(UNIT( I  * 

1) 

*  1  =  1 , 4 )/8HND 

•  8HND 

» 8HNP 

*8HND  7. 

2 

(UNIT ( I  * 

2) 

*  1  =  1*4) /8HCM 

*  BHM 

,  8HFT 

, 8HMI  7, 

3 

(UNIT ( I  * 

3) 

*1=1*4) /8HCM3 

,8HM3 

*  8HFT3 

♦8HGALS  /- 

4 

(UNIT ( I ' 

4) 

*I=1*4)/8HG/CN3 

,8HKG/M3 

*  8HLB7FT3 

.8HG/CN3  /* 

5 

(UNIT ( I  * 

5) 

*  1  =  1 *4 //8HD/CM2 

*8HN/M2 

♦8HPSI 

*8HMN  HG  7, 

6 

(UNIT ( I  * 

6) 

*1=1*4) /8HC 

*8HK 

,  8HF 

,RHK  /* 

7 

<  UN I T ( 1 1 

7) 

*I=1*4)/8HCM2 

*8HM2 

♦  8HFT2 

*8HM2  /, 

R 

(UNIT( I  * 

B) 

,1=1,4 )/8HG 

*  8HKG 

*8HLB 

,8HTN  7, 

9 

(UNIT ( I  * 

9) 

,I=1*4)/8HCL/6C 

*8HJ7KGK 

, 8HBT  7LBF 

*8HCL7GK  / 

L 

ODATA 

t 

(UNIT( I  * 

10) 

*1=1*4) /8HCL/G 

♦8HJ7KG 

*8HBT/LB 

*8HJ/KG  /* 

2 

(UNIT ( I  * 

11) 

*1  =  1  *  4 ) /8HS 

*8HS 

, 8HMIN 

*8HHR  7* 

3 

(UNIT ( I  * 

12) 

*  1  =  1  *  4) 78HG/S 

*8HKG/S 

*8HLB/S 

♦8HTN7HR  /* 

- 

4 

(UNITd, 

13) 

*  1  =  1 *4)/8HRAD 

*  8HRAD 

,8HDEG 

, 8HDEG  /, 

5 

(UNIT(I> 

14) 

*1=1 *4 )/8HCL/CM2S 

*  8HU/N2 

♦8HBT/FT2H 

*8HKC/M2H  /* 

6 

(UNITd* 

15) 

*  1  =  1 *4)78HCM7S 

♦8HN7S 

, 8HNPH 

.8HKN0TS  /* 

7 

(UNITd* 

16) 

*1=1*4) 78HPPH 

,  8HPPH 

, 8HPPM 

*  8HPPN  /, 

8 

(UNITd, 

17) 

» 1  =  1  *  4 )/8HCL7CNSC 

*8HU/MK 

♦8HBT/FTHF 

*8HKC/hHK  /* 

* 

p 

9 

(UNITd* 

18) 

*1=1*4) /8HD/CM 

*  8HN/M 

.•8HLB7S2 

*  8HN7M  7 

ODATA 

1 

(UNITd* 

19) 

*1=1*4) 78HCM27S 

*8HM2/S 

*  8HFT2/S 

*8HM2/S  /* 

2 

(UNITd, 

20) 

*  1  =  1  *  4 )/8H/S 

*8H/S 

,  8H/HIN 

*BH/HR  /* 

3 

(UNITd* 

21) 

*1=1*4) 78HG/HG 

, 8HKG7HKG 

*  8HLB/HLB 

*8HG7HG  7* 

4 

(UNITd, 

22) 

*  1  =  1 *4)/8HDS7CM2 

*8HNS/«2 

*8HCP 

» 8HCP  7* 

5 

(UNITd* 

23) 

*I=1*4)/8HG/GN 

*8HKG/KGN 

*8HLB/LB« 

*8HKG/KGM  7, 

6 

(UNITd, 

24) 

*1  =  1  *  4)/8HL0G  FCN 

, RHLOG  FCN 

*  8HL0G  FCN 

*8HL0G  FCN  /, 

7 

(UNITd* 

25) 

*  1  =  1 *4)/8HG/CM2S 

, 8HKG/N2S 

*8HLB/FT2S 

.8HKG7M2S  /* 

8 

(UNITd, 

26) 

*  1  =  1  *  4 )/8HPERCENT 

♦8HPERCENT 

♦8HPERCENT 

*8HPERCENT  /* 

p 

9 

(UNITd, 

27) 

*I=1*4)/RHG/G 

*8HKG/KG 

.8HLB/LB 

*8HG7KG  7 

L 

ODATA 

1 

(UNITd* 

28) 

♦1=1*4) 78HCL/GNC 

, 8HJ/KGMK 

, 8HBT/LBNF 

*8HCL/Gt1K  /* 

2 

(UNITd* 

29) 

*1=1 *4)/8HG/CM3 

*3HG/CM3 

*  8HG/CM3 

*  8HG/CM3  /* 

3 

(UNITd* 

30) 

*  1=1 *4) /8HG/CM3C 

*8HG/CM3C 

•8HG/CM3C 

*8HG7CM3C  7, 

4 

(UNITd* 

31) 

*1=1 *4) /8HG/CM3C2 

♦8HG7CM3C2 

*8HG7CH3C2 

.8HG/CH3C2  /* 

5 

(UNITd* 

32) 

*  1  =  1 *4)/8HLN  FCN 

,8HLN  FCN 

*8HLN  FCN 

* 8HLN  FCN  7* 

6 

(UNITd, 

33) 

* I=1*4)/8HC 

*  8HC 

*8HC 

*8HC  7* 

7 

(UNITd, 

34) 

*  1  =  1  *  4  > /8HCL/CMSC 

*8HCL/CMSC 

*8HCL/CNSC 

* 8HCL/CMSC  7* 

8 

(UNITd* 

35) 

*I?1*4)/8HCL/CMSC2 

*8HCL/CMSC2 

*8HCL/CMSC2 

*8HCL/CNSC27  * 

c 

9 

(UNITd* 

36) 

*1=1 *4)78HCL/GC 

*8HCL/GC 

*  8HCL/GC 

*8HCl/GC  7 

, 

26 

, 

-  - 

-  .  .  ..... 

_ 

S 

- -  - - -V - -  --  -  - - - 

— 

ODATA 


C 

C- 

C 

C 

C 

C 

C 

C 


(UNIT ( I » 
(UNIT( I » 
(UNIT( I  * 
(UNIT ( I . 
(UNIT ( I » 
(UNIT( I . 
(UNIT ( I » 
(UNIT(I. 
(UNIT ( I » 


ODATA 

1  (UNIT ( I » 

2  (UNIT(I» 


37) »I=1.4)/8HCL/GC2 

38)  »I=1.4)/8HG/HG 

39)  . 1=1 .4)/8HG/HGC 

40) ,I=lf4)/8HCL/GHC 

41 )  » 1=1 »4)/8HCL/GMC2 

42)  f I=lf4)/8HCL/GMC3 

43)  .  1=1.4 )/8HCL/GMC4 

44 )  » 1  =  1 f  4 ) /8HMN  HG 

45)  . 1=1.4) /8HD/CM2 


46)  f 1=1 f 4)/8HNA 

47)  f 1=1 f 4)/8HCM/S 


.8HCL/GC2 

. 8HCL/GC2 

.8HCL/GC2 

/» 

.  8HG/HG 

. 8HG/HG 

. 8HG/HG 

/. 

. 8HG/HGC 

f 8HG/HGC 

f 8HG/HGC 

/. 

.8HCL/GMC 

.  8HCL/GMC 

. 8HCL/GMC 

/. 

. 8HCL/GMC2 

f 8HCL/GMC2 

.8HCL/GMC2 

/. 

>8HCL/GMC3 

.8HCL/GMC3 

. 8HCL/CMC3 

/. 

. 8HCL/GMC4 

f 8HCL/GMC4 

. 8HCL/GMC4 

/. 

. 8HN/M2 

. 8HPSI 

.8HD/CM2 

/. 

. 8HN/M2 

.8HPSI 

» 8HMN/M2 

/ 

.  8HNA 

1 8HNA 

.  8HNA 

/» 

.  8HM/S 

. 8HIN/MIN 

.8HMM/MIN 

/ 

■INITIALIZE  AND  SET  DATA  FOR  OUTPUT  PAGING  CONTROL 


ODATA 

1 


DTE/8H*<DATEt*/. LNCT/O/f LNPG/56/f LP/61/f NPG/O/i 


(TITLE (I) tI=lilO)/10*10H  / 

——SET  RATE  HODEL/PATH  IDENTIFIERS  AND  FIELD 
ODATA  (PTLST <I)*I  =  1* 30 ) / 


SOURCE  LABELS 


1 

4HA 

.  4HB 

.  4HC 

»4HD 

r4HE 

.  4HF 

.  4HG 

» 4HH 

9 

2 

4HI 

.  4HJ 

»4HK 

»4HL 

»4HM 

1 4HN 

f  4H0 

1 4HP 

9 

3 

4HQ 

f  4HR 

.  4HS 

» 4HT 

.  4HU 

» 4HV 

.  4HU 

.  4HX 

9 

4 

4HY 

.  4HZ 

1 4HII 

» 4HRR 

>4HSS 

» 4H 

/ 

ODATA  (SOURC(I)i 1=1.7)/ 

1  8HMISSING  . 8HDEFAULT 

2  8H  USER  . 8H  SYSTEM 


. 8HESTIMATE. 8HCHM 

/ 


PROPf 8HC0MPUTED. 


- SPECIFY  OVERLAY 

DATA  MODNO/O/ 


LOCATIONS  FOR  EACH  RATE  MODEL 


A 

B 

C 

D 

E 

F 

G 

H 

I 

J 

K 

L 

M 

N 

0 

P 

0 

R 

S 

T 

U 

V 

W 

X 

Y 

7 

II  RR 

ss 

ODATA 

(OVLSTd) 

.1=1.29)/ 

3. 

4. 

5. 

6. 

4. 

7. 

5.  4. 

8. 

5. 

1 

8. 

4. 

7. 

5. 

7. 

8. 

4.  8. 

5. 

8. 

2 

4 1 

8. 

5. 

8. 

7, 

7. 

7.  7. 

7/ 

ODATA 

(SGLSTd) 

.1=1.29)/ 

0, 

0. 

0. 

0. 

0. 

0. 

0.  0. 

)• 

0. 

1 

2. 

0. 

0. 

0. 

0, 

2. 

0.  3. 

0. 

4. 

2 

0. 

5. 

0. 

6. 

0. 

0. 

0.  0. 

0/ 

END 

SUBROUTINE 


COMPG(AM.TB.PG) 


cimimummmuumtmntmitntmmmmmmmmmm 

c 

THIS  SUBROUTINE  CALCULATES  THE  DENSITY  OF  A  VAPOR  AT  THE  TEMPER 
OF  TB.  THE  PERFECT  GAS  LAW  IS  USED. 


mm* 

AM 

TB 


INPUT  ARGUMENSTS  *** 

MOLECULAR  WEIGHT  OF  THE  GAS 
TEMPERATURE  AT  WHICH  DENSITY 


IS  DESIRED 


ARGUMENT  **** 
VAPOR  DENSITY 


AT  GIVEN  TEMPERATURE 


DEGREES  C 


GM/CMM3 


C 
C 
C 
C 
C 
C 
C 

C *****  OUTPUT 
C  PG 
C 

cimtmmmtttmtmmmmmummmttmmttmmttmm 

c 

PG=(1 ,01325E6/8.314E7)*AM/(TB+273. ) 

C 

C  **«  VAPOR  DENSITY  IS  AT  1  ATM  PRESSURE.  RUNIV  IS  THE  UNIVERSAL  GAS 
C  CONSTANT  OF  8.314E7  ERG/GM-MOLE  DEG  K 

RETURN 
END 

SUBROUTINE  ENDPR(NAME) 
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nnnnnnnnnnnoo  oonnn 


THIS  SUBROUTINE  INDICATES  THE  COMPLETION  OF  A  MODELS  EXECUTION 

SUBROUTINES  REQUIRED  -  PAGER 

CALL  PAGER(3) 

WRITE(6.100)  NAME 
RETURN 

100  FORMAT < //23H  THE  EXECUTION  OF  M0DEL.A4.14H  IS  COMPLETED.) 

END 

SUBROUTINE  EPRNT ( MOD » IS » IR » IFLAG ) 

SUBROUTINE  EPRNT  PRODUCES  ERROR  MESSAGES  FOR  A  GIVEN  MODEL 
NOD  =  NAME  OF  MODEL 

IS  =  LOWEST  SOURCE  CODE  OBTAINED  IN  A  SERIES  OF  RETRIEVALS 
FROM  THE  MACS  STATE  FILE 

IR  =  ERROR  STATUS  OF  SERIES  OF  STATE  FILE  RETRIEVALS?  SET 
TO  1  ON  INPUT  IF  AT  LEASE  ONE  ERROR  OCCURRED 
IFLAG  =  OUTPUT  INDICATOR*  SET  TO  0  IF  MODEL  IS  NOT  IN  ERROR 
MODE.  SET  TO  1  IF  ERROR  RETURN  IS  TO  BF  EXECUTFH 

SUBROUTINES  REQUIRED  -  PAGER 

OCOMMON/BASE/SAVE ( 2489 ) . UPTH  < 1 5 ) . MSG ( 1 0 ) . MNF » MNI . 

1  NF.NI . LISK275.6)  . FVALC225.3) » IVAL(50.3) 

INTEGER  UPTH 
REAL  MSG 

DIMENSION  STATEI2489) 

EQUIVALENCE  (STATE! 1 ) .MSG( 1 ) ) 

COMMON/MQDCN/MODEX ( 29 ) . MOD  1 0 . LOCIO 
LOGICAL  ENTR.  INTEGR. YESNO 
IF(LOCIO.NE.l)  GO  TO  2 

1  LDCI0=20 
IFLAG=2 
RETURN 

2  CONTINUE 
IFLAG=0 

IF(IS.NE.O)  GO  TO  10 
CALL  PAGER (1) 

WRITE(6. 100)  MOD 
GO  TO  30 

10  IF(IS.NE.l)  GO  TO  20 
CALL  PAGER ( 1 ) 

WRITEC6.102)  MOD 
20  IF(IR.NE.l)  GO  TO  40 
CALL  PAGER ( 1 ) 

URITEU.lOl)  MOD 
30  IFLAG=1 

CALL  PAGER ( 1 ) 

WRITE(6.103) 

RETURN 

40  URITEU.104) 

104  FORMAT  <40H  DO  YOU  WISH  TO  CHANGE  ANY  MODEL  INPUTS?) 

IF(YESN0(0) )  GO  TO  50 

L0CI0=2 

IFLAG*0 

RETURN 

50  WRITE(6.105) 

105  FORMAT  (20H  ENTER  FIELD  NUMBER! ) 

GO  TO  52 

51  WRITEU.107) 

107  FORMAT  OSH  ENTER  FIELD  NUMBER  OR  9999  TO  EXIT) 

52  IF( .NOT .ENTR(O) )  GO  TO  51 

IF ( . NOT . INTEGR ( IFLD ) )  GO  TO  51 
IFdFLD.EQ.9999)  GO  TO  65 
NFLD*NI+NF 
DO  55  I-l.NFLD 


JMiJlD  .EQ.LIST(Iil))  GO  TO  60 
CONTINUE 

WRITE(6rl06)  IFLD 
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106  FORMAT  (14H  FIELD  NUMBER  ?I8?14H  IS  UNDEFINED.) 
GO  TO  51 

60  IVAR=LIST < ILN? 2)/1000 
I£RR=0 
ISRC=6 
LOCIO-3 

IF(IVAR.EQ.O)  CALL  IRCL( IFLD? IVL? ISRCt IERR) 
IF(IVAR.EQ.l)  CALL  FRCL< IFLD? VAL ?  I SRC » IERR ) 

GO  TO  51 
65  L0CI0=20 
IFLAG=2 
RETURN 


AVAILABLE  TC  EXECUTE  MODEL  ?A4) 
IN  READING  THE  DATA  BASE  -  MODEL 


100  FORMAT < lXf 45HINSUFFICIENT  DATA 

101  FORMAT < IX? 51HAN  ERROR  UAS  MADE 

1  A4) 

102  FORMAT ( IX? 16HUARNING  -  MODEL  ,A4?24H  IS  USING  DFFAULT  VALUES) 

103  FORMAT ( IX? 19HEXECUTI0N  OF  MODEL  ?A4?14H  IS  TERMINATED) 

END 

ERR 

. .  ERR 

ERR  BSSZ  1 

1 

Xl  +  1 
B2 
ERR 


IDENT 
ENTRY 
BSSZ 
SB1 
SB2 

EREXIT 
EQ 
END 

SUBROUTINE  FCHCK 

IF  AN  ERROR  OCCURS  DURING  EXECUTION?  CONTRGL  IS  TRANSFERRED 
HERE  BY  COMPASS  ROUTINE  *ERR*.  THE  TYPE  OF  ERROR  IS 
DETECTED  AND  AN  INFORMATIVE  MESSAGE  OUTPUT.  THE  PROGRAM 
IS  THEN  TERMINATED. 

COMMON  VARIABLES  USED  -  LP?NOV?SEG 

SUBROUTINES  REQUIRED  -  PAGER 

AUTHOR  -  R.S.  RIDGLEY?  CONTROL  DATA  CORP. 

6003  EXECUTIVE  BLVD. 

ROCKVILLE?  MD.  20852 
(301)468-8166 

DATE  -  9  MARCH  1977 

COMMON/HEAD/DTE ?LNCT?LNPG?LP?NPG?TITLE( 10) 

COMMON/OVER/NOV?SEG 

DIMENSION  ERRAR ( 1 2 ? 2 ) ? ATHARR ( 8 ? 2 ) 

ODATA  < ERRAR ( 1 ?I)?I=1?2)/10HTINE  LINIT?1H  /? 

1  <ERRAR(2? I ) ? 1=1 ?2) /10H ARITHMETIC? 6H  ERROR/? 

1  (ERRAR< 3? I ) ? 1  =  1 ? 2)/10HPPU  ABORT  ?7H-  RERUN/? 

1  ( ERRAR ( 6 ? I ) ? 1  =  1 ? 2) / 10H0P  DROP-CA ? 1 OHLL  CUST  SV/? 

1  ( ERRAR ( 7 ? I >  ? 1  =  1 ?2) /10HPR0GRAM  ST?2H0P/? 

1  (ERRAR<4? I ) ? 1  =  1 ? 2J/10HCPU  ABORT  ?7H-  RERUN/? 

1  (ERRAR(8»I) ?I=1 ?2)/10HFILE  LIMIT? 1H  /? 

1  (ERRAR(9?I)?I=1?2)/10HTRK  LIM-CA?10HLL  CUST  SV/? 

1  ( ERRAR ( 10? I >  ? 1  =  1 ?2 )/10HSYS  ABT-CAr 1 OHLL  COST  SV/? 

1  < ERRAR < 1 1 » I ) ? 1  =  1 ? 2) /10HF0RCED  ERR?2H0R/? 

1  (ERRAR (12? I) ? 1=1 ?2)/10HPARITY  ERR? 10H0R  -  RERUN/? 

1  (ERRAR<5? I ) ? 1=1 ?2)/10HPP  CALL  ER?9HR  -  RERUN/ 

ODATA  (ATHARR(1?I) ? 1=1 ?2 ) /10HPR0GRAM  ST?2H0P/? 

1  (ATHARR(2?I) ?I=1 ?2)/10HBAD  SUBSCR?3HIPT/? 

1  ( ATHARR (3? I ) ? 1*1 ?2>/10H0VER/UNDER?5H  FLOU/? 

1  (ATHARR (4? I ) ? 1=1 ?2> /10HBD  SCRPT-O? 10HVR/UND  FLU/? 

1  (ATHARR(5?I)?I=1?2)/10HDVD  BY  ZER?1H0/? 

1  (ATHARR(6?I ) ? 1  =  1 ? 2 )/10HBD  SCRPT-D? 10HVD  BY  ZERO/? 

1  (ATHARR(7?I) ?I*1?2)/10H0VR/UND  FL?10HW-DVD  BY  0/? 

1  (ATHARR<8?I)?I=1?2)/10HUNDETERMIN?8HED  ERROR/ 

FETCH  RA+O  CONTINAING  ERROR  INFORMATION 
IRA=MEMGET<0> 

MASK  OFF  ERROR  FLAG  IN  BITS  24-29  AND  RIGHT  JUSTIFY 
IEF*AND(IRA? 7700000000B) 

IEFL*SHIFT ( IEF? -24 ) 
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MASK  OFF  ERROR  MODE  IN  BITS  48-53  AND  RIGHT  JUSTIFY 
IEM*AND(IRA»  770000000000000000B > 

I£MD=SHIFT (IEM,-48) 

EXTRACT  ADDRESS  OF  ERROR 

IADD  *  AND( IRA, 7777 77000 000 000 OB) 

IADD  =  SHIFT ( IADDt-30) 

CALL  PAGER (1 ) 

WRITE (LP, 1000) NOV, SEG, (ERRAR( IEFL»I)*1=1»2) 

IFdEFL  ,EQ.  2 ) WRITE ( LP » 1001 ) ( ATHARRdEMD  +  1 »I)»I=1»2) 

WRIT£(LP, 1002) IADD, IADD 
ENDFILE  61 
ENDFILE  62 

FORMAT ( 12H  IN  OVERLAY  , 12 ,9H, SEGMENT  ,I2,5H»*t*  ,2A10> 

FORMAT (31X,4H*tt  ,2A10) 

FORMAT (/f  ADDRESS  OF  ERROR  IS  * (DECIMAL)-  *»I7,*  (OCTAL)  1 

+,010) 

STOP 

END 

SUBROUTINE  FCNV(IFLD,ILN,VAL,ITYP»IS) 

SUBROUTINE  FCNV  IS  USED  TO  GENERATE  DISPLAYS  OF  REA!.  FIELD 
VALUES  IN  ALTERNATE  SYSTEMS  OF  UNITS  OF  MEASURE  AS  PART  OF 
THE  HACS  DATA  BASE  SAVE  AND  RECALL  FUNCTIONS.  OUTPUT  PRODUCED 
BY  THIS  ROUTINE  IS  CONTROLLED  BY  THE  OPTION  ICVSL  TO  DISPLAY 
FIELD  VALUES  IN  A  SINGLE  SPECIFIED  SYSTEM  OF  UNITS,  OR  IN 
ALL  UNIQUE  UNITS  DEFINED  FOR  THE  FIELD. 

FAC  =  ARRAY  OF  UNIT  CONVERSION  FACTORS  FOR  TEMPERATURES 

I  *  INDEX  ON  UNIT  SYSTEMS  FROM  1  TO  MSYS 

IFLD  =  ARGUMENTi  FIELD  NUMBER 

ILN  *  ARGUMENT,  INDEX  TO  FIELD  NAME  IN  STATE  FILE 

IS  =  ARGUMENT,  INDEX  (-1)  TO  SOURCE  CODE  LABEL 

ITYP  =  ARGUMENT,  QUANTITY  TYPE  CORRESPONDING  TO  FIELD  VALUE 

TO  BE  CONVERTED  FOR  OUTPUT  DISPLAY 
J  =  INDEX  RANGING  FROM  1  TO  1-1  USED  TO  DETECT  DUPLICATE 

UNIT  LABELS,  ALSO  INDEX  FOR  NAME  OUTPUT 
JJ  =  INTEGER  SELECTOR  SET  TO  SYSTEM  OF  UNITS  FOR  WHICH 
A  FULL  AUDIT  LINE  IS  PRINTED 

TAG  =  TEMPORARY  STORAGE  FOR  UNIT  LABEL  IN  SYSTEM  I,  FOR 
QUANTITY  TYPE  ITYP 

VAL  =  ARGUMENT,  FIELD  VALUE  IN  INTERNAL  SYSTEM  OF  UNITS 
XVAL  *  FIELD  VALUE  CONVFRTED  TO  UNIT  SYSTEM  I  FOR  OUTPUT 

COMMON  VARIABLES  USED  -  CONV, ICVSL, LIST, LP, MSYS, NPRRP,SOURC, 

UNIT 


SUBROUTINES  REQUIRED  -  PAGER 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/309A  ACORN  PARK, 
CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  29  JANUARY  1976 


OCOMMON/BASE/SAVE ( 2489) ,UPTH( 15) , MSG (10) ,MNF,MNI , 

1  NF»NI »LIST(275 ,6) »FVAL(225»3) , I VAL (50, 3) 

INTEGER  UPTH 

REAL  MSG 

DIMENSION  STATE (2489) 

EQUIVALENCE  (STATEd  )  ,MSG(1 ) ) 

C 

COMMON/CNVDT /CONV (3,47), MSYS , MT YP , UNIT ( 4 , 47 ) 

C 

COMMON/HE AD/DTE, LNCT ,LNPG,LP,NPB,TITLE( 10) 

C 

COMMON/IOCNT/ICVSL , IPRAC, IPRRP,NOFF»NPRRP 
C 

COMMON/NAME/PTLST ( 30 ) , SOURC ( 7 ) 

INTEGER  PTLST 
C 
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DIMENSION  FAC(3) 

DATA  (FAC( I )*Ial*3)/l. 0*1.8*1.07 *FBLNK/8H 


- SUPPRESS  DISPLAY  IF  NPRRP  SWITCH  IS  SET  TO  0  FOR  SUPPRESSING 

AUDIT  OF  PROPERTY  FILE  ACCESS 
IF (NPRRP. EQ.O)  RETURN 


-—INITIALIZE  LOOP  USING  INDEX  I  ON  SYSTEM  OF  UNITS  SELECTED 
OR  TO  FIRST  SYSTEM  IF  ICVSL  SET  TO  0  FOR  ALL  SYSTEMS. 
I-ICVSL 
IF(I.EQ.O)  1=1 


—SET  INDICATOR  JJ  TO  CONTROL  OUTPUT  FORMAT  FOR  FIRST  LINE  AND 
RETRIEVE  LABEL  TAG  FOR  FIRST  LINE  VALUE 
JJ*I 

TAG=UNIT ( I * ITYP) 


. CONVERT  FIELD  VALUE  IN  SYSTEM  1  (INTERNAL)  TO  SELECTED 

SYSTEM  FOR  OUTPUT  DISPLAY.  BRANCH  ON  TYPE  OF  PHYSICAL 
QUANTITY  TO  SELECT  CONVERSION  EQUATION. 

IF(I.NE.l)  GO  TO  20 

XVAL=VAL 

GO  TO  40 

20  IF(ITYP.EQ.6)  GO  TO  30 
XVAL=VAL/C0NV(I-1 * ITYP) 

GO  TO  40 

30  XVAL=C0NV ( 1-1 » ITYP )+VAL*FAC< 1-1 ) 


- DISPLAY  CONVERTED  VALUE  AS  PART  OF  AUDIT  OUTPUT 

40  CALL  PAGER(l) 

OIF(I.EQ.JJ)  WRITE(LP* 1020)  IFLD* (LIST ( ILN* J  >  * J-3*5) * XVAL  *TAG* 
1  SOURC(ISH) 

IF(I.NE.JJ)  WRITE(LP.IOOO)  XVAL* TAG 


. TEST  FOR  COMPLETION  ON  SINGLE  UNIT  OPTION  OR  ALL  UNIQUE 

UNITS  DISPLAYED. 

IF(ICVSL.NE.O)  GO  TO  70 
50  1*141 

IF(I.GT.MSYS)  GO  TO  70 


. AUDIT  VALUE  WHEN  OPTION  FOR  ALL  SYSTEMS  SELECTED  ONLY  USING 

EACH  UNIQUE  UNIT.  OMIT  DUPLICATES.  NOTE  THAT  I  CANNOT  BE  1. 
TAG=UNIT(I*ITYP) 

J=1 

AO  IF(TAG.EQ.UNIT(J»ITYP))  GO  TO  50 
J=J+1 

IF(J.LT.I)  GO  TO  60 
GO  TO  20 


. INSERT  SPACE  BETWEEN  DISPLAYS  FOR  DIFFERENT  FIELD  VALUES  ON 

OUTPUT  AUDIT, 

70  CALL  PAGER(l) 

WRITE (LP» 1010) 

RETURN 


1000  FORMAT  (24X*3H=  *G13.4*2X»A8) 

1010  FORMAT  (5X) 

1020  FORMAT  <5X*I4*1X»3A4»5H  =  *G13.4* 

END 

SUBROUTINE  FRCL ( IFLD* VAL » ISRC r IERR ) 


*  G13.4*2X*AB*8H*  IS  A  »A8*7H  VALUE) 


SUBROUTINE  FRCL  RECALLS  THE  VALUE  (VAL)  OF  A  REAL  FIELD* 

DEFINED  BY  THE  FIELD  NUMBER  IFLD*  FROM  THE  HACS  STATE  FILE. 
ERROR  CONDITIONS  WILL  PRODUCE  MESSAGES*  AND  CAUSE  VALUES  OF 
VAL*0.0*  IERR«1  AND  ISRC*0  TO  BE  RETURNED.  ARGUMENTS  ISRC  AND 
IERR  ARE  INITIALIZED  AND  TESTED  IN  A  CALLING  PROGRAM  TO 
DETERMINE  THE  STATUS  OF  A  GROUP  OF  DATA  BASE  RECALL  OPERATIONS. 


=  INTEGER  FORTRAN  ARRAY  INDEX 


V 


I ERR  =  ERROR  CONDITION  INDICATOR  SET  TO  1  IF  ANY  ERROR  IS 
DETECTED  IN  PERFORMING  THE  REQUESTED  RECALL 
IFLD  =  ARGUMENT!  FIELD  NUMBER  FOR  WHICH  VALUE  IS  REQUESTED 
ILN  =  INDEX  INTO  STATE  FILE  TO  OBTAIN  DEFINITION  OF  FIFLD 

IS  =  SOURCE  CODE  FOR  VALUE  CURRENTLY  STORED  IN  STATE  FILE 

ISRC  =  ARGUMENT!  MINIMUM  SOURCE  CODE  FOUND  IN  ONE  OR  MORE 

RECALL  OPERATIONS  GROUPED  FOR  INPUT  TO  A  RATE  MODEL 
ITYP  =  PRE-DEFINED  TYPE  OF  PHYSICAL  QUANTITY  FOR  FIELD  IFLD 
IVAR  =  TYPE  OF  INTERNAL  FIELD  STORAGE  FOR  FIELD  IFLD 
(0  FOR  INTEGER!  1  FOR  REAL) 

IX  =  INDEX  STORED  IN  STATE  FILE  TO  LINK  FIELD  DEFINITION 
TO  FIELD  VALUE  ARRAYS 

NFLD  =  (NIfNF)  GIVES  THE  TOTAL  NUMBER  OF  FIELD  DEFINITIONS 
ACTUALLY  STORED  IN  THE  STATE  FILE 
VAL  =  ARGUMENT!  RETURNED  AS  VALUE  OF  FIELD  IFLD!  AS  RECALLED 
FROM  THE  STATE  FILE  IN  INTERNAL  UNITS!  OR  0.0  IF 
AN  ERROR  WAS  ENCOUNTERED. 

COMMON  VARIABLES  USED  -  FVAL!LIST!LPiNF!NI 

SUBROUTINES  REQUIRED  -  FCNV!PAGER 

AUTHOR  -  R.G.  POTTS!  ARTHUR  D.  LITTLE!  INC.! 

35/309A  ACORN  PARKf 
CAMBRIDGE!  MASS.!  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  29  JANUARY  1976 

0C0MM0N/BASE/SAVE<2489) !UPTH( 15) !MSG( 10) !MNF>MNI ! 

1  NF!Nl!LIST(275!6)!FVAL(225!3)!lVAL(50!3) 

INTEGER  UPTH 

REAL  MSG 

DIMENSION  STATE(24B9) 

EQUIVALENCE  (STATE ( 1 ) !MSG< 1 ) ) 

C0MM0N/CNVDT/C0NV<3!47)fMSYSiMTYp!UNIT(4!47) 

COMMON/HEAD/BTE!  LNCTiLNPG^Pt  NPG!  TITLE  ( 10) 
COMMON/MODCN/MODEX(29)!MODIO!LOCIO 

COMMON/NAME/PTLST (30) ! SOURC ( 7 ) 

INTEGER  PTLST 


COMMON/ IOCNT/ICVSL ! IPRACt IPRRP ! NOFF t NPRRP 
LOGICAL  QUEST 

LOGICAL  YESNO!ENTR!FLTPT!NAME 
DIMENSION  FAC (1 ) 

DATA  ( FAC < I ) ! I  =  1 ! 3 ) /1 . 0 ! 1 . 8 ! 1 . 0/ 


. LOOP  THROUGH  ALL  FIELD  DEFINITIONS  IN  STATE  FILE  TO  LOCATE 

FIELD  NUMBER  IFLD,  NOTE  THAT  AT  LEAST  ONE  FIELD  (FOR  CHEMICAL 
RECOGNITION  CODE)  BY  DEFINITION  HAS  BEEN  PREVIOUSLY  DEFINED. 
THE  VARIABLE  ILN  SAVES  THE  LOCATION  IN  THE  STATE  FILE 
CORRESPONDING  TO  FIELD  NUMBER  IFLD!  IF  FOUND. 

NFLD=NI+NF 
DO  10  1=1 !NFLD 
ILN=I 

IF ( IFLD .EQ. LIST ( I ! 1 ) )  GO  TO  20 
10  CONTINUE 


- ERROR.  THE  REQUESTED  FIELD  NUMBER  DOES  NOT  EXIST  IN  THE  HACS 

STATE  FILE.  THIS  CONDITION  INDICATES  EITHER  AN  ERROR  IN 
PROGRAM  CODING  OF  CALLS  TO  SUBROUTINE  FRCLf  OR  A  MISSING 
DEFAULT  FILE  SPECIFICATION  TO  DEFINE  THE  FIELD  BEING  REQUESTED. 
CALL  PAGER(2> 

WRITE(LPrlOOO)  IFLD 
GO  TO  60 

——VERIFY  REQUEST  FOR  REAL  VARIABLE  WITH  STORAGE  MODE  OF  VARIABLE 
IN  STATE  FILE. 


V 


non  oo  oooooo  o  ooo  ooo 


20  IVAR=LIST(ILN.2)/1000 
IF ( IVAR.EQ. 1 )  GO  TO  30 


- ERROR.  FLOATING  POINT  VALUE  HAS  BEEN  REQUESTED  FOR  VARIABLE 

DEFINED  IN  STATE  FILE  AS  AN  INTEGER. 

CALL  PAGER<2> 

WRITE(LP.IOIO)  IFLD. (LIST ( ILN. I ). 1=3.5) 

GO  TO  60 

. FIELD  TYPE  IS  REAL.  UNPACK  QUANTITY  TYPE  AND  SOURCE  CODE  OF 

STORED  VALUE. 

30  IS=1000*IVAR 

ITYP=(LIST(ILN»2)-IS)/10 

IS=LIST(ILN.2)-10*ITYP-IS 


. UPDATE  SUBROUTINE  ARGUMENT  TO  TRACK  LOWEST  SOURCE  CODE  OF 

FIELD  VALUES  RECALLED  FOR  USE  IN  EXECUTING  A  RATE  MODEL. 
IF(IS.LT.ISRC)  ISRC=IS 

- IF  FIELD  VALUE  HAS  NOT  BEEN  DEFINED.  SET  ERROR  FLAG  AND  USE 

0.0  FOR  STANDARD  AUDIT. 

IF(IS.GT.O)  GO  TO  40 

IERR=1 

VAL=0.0 

GO  TO  50 

- INDEX  INTO  DATA  ARRAY  TO  RETURN  VALUE  OF  REQUESTED  FIELD 

40  IX=LIST ( ILN.6) 

VAL=FVAL ( IX » 1 ) 


- GENERATE  HACS  AUDIT  DISPLAY  FOR  FIELD  DEFINITION  AND  CURRENT 

VALUES  IN  ALL  DEFINED  UNIT  SYSTEMS. 

50  IF(L0CI0.NE.2>  GO  TO  100 

C - SECTION  FOR  LOCIO  =  2.  RECALL  AND 

C  DISPLAY  FOR  MODEL  SUMMARY. 

51  CALL  FCNV< IFLD. ILN. VAL. ITYP. IS) 

IF (LOCIO.NE .2)  GO  TO  190 

C . — MIN/MAX  TEST 

99  FMN=FVAL< IX. 2) 

FMX=FVAL( IX.3) 

IF (VAL.LT .FMN)  GO  TO  260 
IF(VAL.LE.FMX)  GO  TO  270 
260  WRITE(LP»2040 )  VAL.FMN.FMX.UNIT(l.ITYP) 

20400F0RMAT  (25H  WARNING.  FIELD  VALUE  OF  .G13.4.11H  NOT  WITHIN  / 

1  18H  NOMINAL  RANGE  OF  .GI3.4.4H  TO  .G13.4.4H  IN  .A8> 

270  CONTINUE 
GO  TO  280 

100  IF(L0CI0.EQ.3)  GO  TO  105 
IF(IS.GT.l)  GO  TO  280 

1050WRITE(LP» 110)  ( LIST <  ILN.  I ).  1=3.5) .UNIT< 1 . ITYP) .UNIT (2. ITYP) . 

1  UNITI3. ITYP). UNIT<4, ITYP) 
llOOFORMAT  (22H  ENTER  REAL  VALUE  FOR  .3A4. 

1  4H  IN  .A8.1H.A8.1H.A8. 1H.A8) 

IF ( .NOT ,ENTR(0) )  GO  TO  51 
IF< .NOT .QUEST(O) )  GO  TO  199 
CALL  EXF'LAIN(ILN) 

GO  TO  105 

199  CONTINUE 

IF ( .NOT .FLTPT(FVL) )  GO  TO  105 
ISYS=1 

IF ( .NOT .NAME(TAG) )  GO  TO  220 

200  IF(TAG.EQ.UNIT( I SYS. ITYP) )  GO  TO  220 
ISYS=ISYS+1 

IF(ISYS,LE.4)  GO  TO  200 
WRITE(LP,2020)  TAG 

2020  FORMAT  (13H  UNIT  LABEL  /.A10.12H/  IS  INVALID) 

GO  TO  105 

220  IF(ISYS.EQ.l)  GO  TO  250 
JSYS*ISYS-1 
D=CONV( JSYS. ITYP) 

IF ( ITYP »NE .6)  GO  TO  230 
FVL*(FVL-D) /FAC (JSYS) 
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GO  TO  240 
230  FVL=D*FVL 
240  CONTINUE 
250  CONTINUE 

C - REPLACE  STATE  FILE  VALUE 

FVAL( I X » 1 )=FVL 
VAL=FVL 

LIST(ILN,2)=LIST(ILN,2>-IS+5 

IS=5 

GO  TO  99 

190  WRITE(LP,195> 

195  FORMAT  (31H  DO  YOU  WISH  TO  USE  THIS  VALUE? ) 

IF< YESNO(O) )  GO  TO  99 
GO  TO  105 

280  IF(IS.LT.ISRC)  ISRC=IS 
RETURN 
60  IERR=1 
ISRC=0 
VAL=0 . 0 
RETURN 
C 

10000F0RMAT  <5X,26H*****ERR0R  -  FIELD  NUMBER  »I4,42H  REQUESTED  FOR  RECA 
ILL  HAS  NOT  BEEN  DEFINED/) 

10100F0RMAT  <5X,53H*m*ERR0R  -  REAL  RECALL  REQUESTED  FOR  INTEGER  FIELD 
1  ,I4,lX,3A4/> 

END 

SUBROUTINE  FSV( IFLD. UAL , ISRC > 

SUBROUTINE  FSV  SAVES  THE  VALUE  (VAL)  OF  A  REAL  FIELD.  DEFINED 
BY  THE  FIELD  NUMBER  IFLD.  IN  THE  HACS  STATE  FILE  DEPENDING  ON 
THE  SOURCE  CODE.  THE  NEW  VALUE  IS  SAVED  IF  ITS  SOURCE  CODE 
(ISRC)  IS  GREATER  THAN  THE  SOURCE  CODE  OF  THE  VALUE  ALREADY 
STORED  IN  THE  STATE  FILE.  WHETHER  OR  NOT  THE  VALUE  IS  SAVED. 
THE  ROUTINE  PRODUCES  AN  OUTPUT  AUDIT. 


I  =  INTEGER  FORTRAN  ARRAY  INDEX 

IFLD  =  ARGUMENT,  FIELD  NUMBER  FOR  WHICH  VALUE  IS  TO  BE  SAVED 

ILN  =  INDEX  INTO  STATE  FILE  TO  OBTAIN  DEFINITION  OF  FIELD 
IS  =  SOURCE  CODE  FOR  VALUE  CURRENTLY  STORED  IN  STATE  F1LF 

ISRC  =  ARGUMENT,  SOURCE  CODE  ASSOCIATED  WITH  VALUE  OF  FIELD 

TO  BE  SAVED 

ITYP  =  PRE-DEFINED  TYPE  OF  PHYSICAL  QUANTITY  FOR  FIELD  IFLD 
IVAR  =  TYPE  OF  INTERNAL  FIELD  STORAGE  FOR  FIELD  IFLD 
(0  FOR  INTEGER,  1  FOR  REAL) 

IX  =  INDEX  STORED  IN  STATE  FILE  TO  LINK  FIELD  DEFINITION 
TO  FIELD  VALUE  ARRAYS 

NFLD  =  (NI+NF )  GIVES  THE  TOTAL  NUMBER  OF  FIELD  DEFINITIONS 
ACTUALLY  STORED  IN  THE  STATE  FILE 
VAL  =  ARGUMENT,  GIVES  VALUE  OF  FIELD  IFLD  TO  BE  SAVED 

COMMON  VARIABLES  USED  -  FVAL, LIST, LP,NF,NI,NPRRP,SOURC, UNIT 

SUBROUTINES  REQUIRED  -  FCNV, PAGER 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT,  2813 
DATE  -  3  FEBRUARY  1976 


OCOMMON/BASE/SAVE ( 2489 ) ,UPTH( 15) ,MSG( 10)  .MNF.MNI , 

1  NF,NI,LIST(275,6) , FVAL (225, 3) , I VAL <50, 3) 

INTEGER  UPTH 

REAL  MSG 

DIMENSION  STATE<2489) 

EQUIVALENCE  (STATE ( 1 ) ,MSG( 1 ) > 

COMMON/CNVDT/CONV ( 3 , 47 ) , MSYS , MTYP , UNIT ( 4,47) 

C 

COMMON/HEAD/DTE, LNCT.LNPG.LP.NPG, TITLE (10) 


V-  -E'  > 
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C 


COMMON/I OCNT/ I CVSL » IPRAC, I PRRP»NQFF  ,NPRRP 


COMMON/NAME/PTLST (30) »S0URC<7) 
INTEGER  F'TLST 


- LOOP  THROUGH  ALL  FIELD  DEFINITIONS  IN  STATE  FILE  TO  LOCATE 

FIELD  NUMBER  IFLD.  NOTE  THAT  AT  LEAST  ONE  FIELD  (FOR  CHEMICAL 
RECOGNITION  CODE)  BY  DEFINITION  HAS  BEEN  PREVIOUSLY  DEFINED . 
THE  VARIABLE  ILN  SAVES  THE  LOCATION  IN  I  HE  STATE  FILE 
CORRESPONDING  TO  FIELD  NUMBER  IFLD,  IF  FOUND, 

NFLB=NI+NF 
DO  10  1  =  1 , NFLD 
ILN=I 

IFdFLD.EQ.LISTd»l>>  GO  TO  20 
10  CONTINUE 


- ERROR.  THE  REQUESTED  FIELD  NUMBER  DOES  NOT  EXIST  IN  THE  HACP 

STATE  FILE.  THIS  CONDITION  INDICATES  EITHER  AN  ERROR  IN 
PROGRAM  CODING  OF  CALLS  TO  SUBROUTINE  FRCL »  OR  A  MISSING 
DEFAULT  FILE  SPECIFICATION  TO  DEFINE  THE  FIELD  BFTNG  REQUESTED, 
CALL  PAGER (2) 

WRITE(LP.IOOO)  IFLD 
RETURN 


- VERIFY  REQUEST  TO  SAVE  REAL  VARIABLE  WITH  STORAGE  MODE  OF 

VARIABLE  IN  STATE  FILE, 

20  I VAR=LIST (ILN,2)/1000 
IF(IVAR.EQ.l)  GO  TO  30 


- ERROR.  FLOATING  POINT  VALUE  TO  BE  SAVED  FDR  VARIABLE  STORED 

IN  STATE  FILE  AS  AN  INTEGER, 

CALL  PAGER! 2) 

WRITE(LP.IOIO)  IFLD, (LIST ( ILN , I). 1=3 ,5) 

RETURN 


- FXELD  TYPE  IS  CORRECT,  UNPACK  CODES  FROM  STATE  FILE. 

30  IS=1000*IVAR 

ITYP=(LIST (ILN,2)-IS)/10 
IS=LIST(ILN,2)-10*ITYP-IS 
IX=LIST  < ILN, 6 ) 


- GENERATE  HACS  AUDIT  DISPLAY  FOR  FIELD  DEFINITION  AND  VALUE 

REQUESTED  TO  BE  SAVED.  NOTE  THAT  THE  VALUE  DISPLAYED  MAY 
NOT  BE  SAVED  IN  THE  STATE  FILE, 

CALL  FCNVdFLD,  ILN ,  VAL ,  I TYF' ,  ISRC ) 


. —GENERATE  WARNING  MESSAGE  IF  VALUE  TO  BE  SAVED  EXCEEDS  LIMITS. 

IF(VAL.GE.FVAl  ( IX, 2 ) . AND, VAL . LE . FVAL ( I X , 3) >  GO  TO  40 

IF(NPRRP.NE.O)  GO  TO  35 

NPRRP=1 

CALL  FCNV (IFLD, ILN, VAL, ITYP, ISRC) 

NPRRP=0 
35  CONTINUE 

CALL  PAGER(5) 

OWRITE(LP, 1030)  IFLD, (IIST< ILN, I ) , 1=3,5) ,FVAl< IX, 2) rFVAL ( IX, 3) , 

1  UNIT ( 1 , ITYP ) 


. —COMPARE  SOURCE  CODE  OF  VALUE  TO  BF.  SAVED  TO  SOURCE  CODE  OF 

VALUE  ALREADY  STORED  IN  STATE  FILE.  UPDATE  ONLY  IF  NEW  SOURCE 
CODE  EXCEEDS  PREVIOUS  SOURCE  CODE, 

40  IF ( ISRC.LT .IS)  GO  TO  50 

LIST(ILN,2)=LIST(ILN,2)+ISRC-1S 

FVAL ( IX, 1 )=VAL 

RETURN 


- WRITE  NOTE  THAT  VALUE  DID  NOT  HAVE  HIGHER  SOURCE  CODE  AND  WAS 

NOT  PLACED  IN  THE  STATE  FILE. 

50  IF(NPRRP.NE.O)  GO  TO  55 
NPRRP= 1 

CALL  FCNVdFLD, ILN, VAL, ITYP, ISRC) 


uuouuuuuuuuuu  uoouuuuouuuuuuouuuuu  uuuu 


NPRRP=0 
55  CONTINUE 

CALL  PA6ER(3) 

WRITE (LP? 1040)  FVAL! IX? 1 ) ?UNIT( 1 » I TYP > ?S0URC( IS+1 ) 

RETURN 

* 

'lOOOOFORHAT  (5X?26H**mERR0R  -  FIELD  NUMBER  ?I4?40H  REQUESTED  FOR  SAVE 
1  HAS  NOT  BEEN  DEFINED/) 

10100F0RMAT  (5X?51H*m*ERR0R  -  REAL  SAVE  REQUESTED  FOR  INTEGER  FIELD  ? 
1  I4?lX?3A4/> 

10300F0RMAT  !5X?30H*m*WARNING  -  VALUE  OF  FIELD  ?I4?1X?3A4/ 

1  10Xf 47HREQUESTED  TO  BE  SAVED  EXCEEDS  NOMINAL  LIMITS  OF/ 

2  10X?G13.4?4H  TO  ?G13.4?2X?A8/10X?40HSUBSEQUENT  CALCULATIONS  MAY 
3N0T  BE  VALID/) 

10400F0RMAT  (5X? 35H*****N0TE  -  VALUE  IN  STATE  FILE  OF  ?G13.4?2X?A8/ 

1  lOXrSHIS  A  ? A8  ?27H  VALUE  AND  WAS  NOT  REPLACED/) 

END 

SUBROUTINE  IRCL< IFLD? IVL? ISRC ? IERR) 

SUBROUTINE  IRCL  RECALLS  THE  VALUE  (IVL)  OF  AN  INTEGER  FIELD? 
DEFINED  BY  THE  FIELD  NUMBER  IFLD?  FROM  THE  HACS  STATE  FILE. 
ERROR  CONDITIONS  WILL  PRODUCE  MESSAGES?  AND  CAUSE  VALUES  OF 
IVL=0?  IERR=1  AND  ISRC=0  TO  BE  RETURNED.  ARGUMENTS  ISRC  AND 
IERR  ARE  INITIALIZED  AND  TESTED  IN  A  CALLING  PROGRAM  TO 
DETERMINE  THE  STATUS  OF  A  GROUP  OF  DATA  BASE  RECALL  OPERATIONS. 


I  =  INTEGER  FORTRAN  ARRAY  INDEX 

IERR  =  ERROR  CONDITION  INDICATOR  SET  TO  1  IF  ANY  ERROR  IS 
DETECTED  IN  PERFORMING  THE  REQUESTED  RECALL 
IFLD  =  ARGUMENT?  FIELD  NUMBER  FOR  WHICH  VALUE  IS  REQUESTED 
ILN  =  INDEX  INTO  STATE  FILE  TO  OBTAIN  DEFINITION  OF  FIELD 

IS  =  SOURCE  CODE  FOR  VALUE  CURRENTLY  STORED  IN  STATE  FILE 

ISRC  =  ARGUMENT?  MINIMUM  SOURCE  CODE  FOUND  IN  ONE  OR  MORE 

RECALL  OPERATIONS  GROUPED  FOR  INPUT  TO  A  RATE  MODEL 
ITYP  *  PRE-DEFINED  TYPE  OF  PHYSICAL  QUANTITY  FOR  FIELD  IFLD 
IVAR  =  TYPE  OF  INTERNAL  FIELD  STORAGE  FOR  FIELD  IFLD 
(0  FOR  INTEGER?  1  FOR  REAL) 

IVL  *  ARGUMENT?  RETURNED  AS  VALUE  OF  FIELD  IFLD?  AS  RECALLED 
FROM  THE  STATE  FILE  IN  INTERNAL  UNITS?  OR  0  IF 
IX  =  INDEX  STORED  IN  STATE  FILE  TO  LINK  FIELD  DEFINITION 
TO  FIELD  VALUE  ARRAYS 

NFLD  =  (NI+NF )  GIVES  THE  TOTAL  NUMBER  OF  FIELD  DEFINITIONS 
ACTUALLY  STORED  IN  THE  STATE  FILE 

COMMON  VARIABLES  USED  -  IVAL?LIST?LP?NF?NI?SOURC?UNIT 

SUBROUTINES  REQUIRED  -  PAGER 

AUTHOR  -  R.G.  POTTS?  ARTHUR  D.  LITTLE?  INC.? 

35/309A  ACORN  PARK? 

CAMBRIDGE?  MASS.?  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  29  JANUARY  1976 

OCOMMON/BASE/SAVE ( 2489 ) ?  UPTH ( 1 5 ) ?  MSG ( 10 ) ?  MNF  ?  MNI ? 

1  NF?NI?LIST(275?6)?FVAL(225?3)?IVAL<50?3) 

INTEGER  UPTH 

REAL  MSG 

DIMENSION  STATE(2489) 

EQUIVALENCE  (STATE! 1 ) ?MSG(1 ) ) 

COMMON/CNVDT /CQNV <  3  ?  47 ) ?  MS YS  ?  MTYP ?  UNIT ( 4  ?  47 ) 

COMMON/HEAD/DTE ?LNCT  ?LNPG?LP?NPG? TITLE! 10) 

COMMON/MODCN/MODEX! 29) ?MODIO?  LOCIO 

COMMON/NAME/PTLST ! 30 ) ?  SOURC ! 7 ) 

INTEGER  PTLST 

LOGICAL  YESNO?ENTR? INTEGR 
LOGICAL  QUEST 
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. -LOOP  THROUGH  ALL  FIELD  DEFINITIONS  IN  STATE  FILE  TO  LOCATE 

FIELD  NUMBER  IFLD.  NOTE  THAT  AT  LEAST  ONE  FIELD  (FOR  CHEMICAL 
RECOGNITION  CODE)  BY  DEFINITION  HAS  BEEN  PREVIOUSLY  DEFINED, 
THE  VARIABLE  ILN  SAVES  THE  LOCATION  IN  THE  STATE  FILE 
CORRESPONDING  TO  FIELD  NUMBER  IFLD*  IF  FOUND. 

NFLD=NI+NF 
DO  10  1*1 *NFLD 
ILN*I 

IF ( IFLD.EQ.LISTd , 1 ) )  GO  TO  20 
10  CONTINUE 


- ERROR.  THE  REQUESTED  FIELD  NUMBER  DOES  NOT  EXIST  IN  THE  HACS 

STATE  FILE.  THIS  CONDITION  INDICATES  EITHER  AN  ERROR  IN 
PROGRAM  CODING  OF  CALLS  TO  SUBROUTINE  IRCL,  OR  A  MISSING 
DEFAULT  FILE  SPECIFICATION  TO  DEFINE  THE  FIELD  BEING  REQUESTED, 
CALL  PAGER(2) 

URITE(LP.IOOO)  IFLD 
GO  TO  60 


. VERIFY  REQUEST  FOR  INTEGER  VARIABLE  WITH  STORAGE  MODE  OF 

VARIABLE  IN  STATE  FILE 
20  IVAR=LIST(ILN,2)/1000 
IF(IVAR.EQ.O)  GO  TO  30 


- ERROR.  INTEGER  VALUE  HAS  BEEN  REQUESTED  FOR  VARIABLE  DEFINED 

IN  STATE  FILE  AS  A  FLOATING  POINT  VALUE. 

CALL  PAGER<2> 

WRITE(LP,1010>  IFLD* (LIST (ILN*I ) *  1=3*5) 

GO  TO  60 


- FIELD  TYPE  IS  INTEGER*  UNPACK  QUANTITY  TYPE  AND  SOURCE  CODE  OF 

STORED  VALUE. 

30  IS=1000*IVAR 

ITYP=(LIST(ILN*2)-IS)/10 

IS=LIST(ILN.2)-10*ITYP-IS 


■—UPDATE  SUBROUTINE  ARGUMENT  TO  TRACK  LOWEST  SOURCE  CODE  OF 
FIELD  VALUES  RECALLED  FOR  USE  IN  EXECUTING  A  RATE  MODEL. 
IF(IS.LT.ISRC)  ISRC*IS 


- IF  FIELD  VALUE  HAS  NOT  BEEN  DEFINED,  SET  ERROR  FLAG  AND  USE 

0  FOR  STANDARD  AUDIT. 

IF(IS.GT.O)  GO  TO  40 

IERR=1 

IVL=0 

GO  TO  50 


- INDEX  INTO  DATA  ARRAY  TO  RETURN  VALUE  OF  REQUESTED  FIELD 

40  IX=LIST < ILN*6) 

IVL=IVAL(IX,1) 

. GENERATE  HACS  AUDIT  DISPLAY  FOR  FIELD  DEFINITION  AND  CURRENT 

VALUE  IN  INTERNAL  UNITS 

50  IF(LQCI0.NE.2>  GO  TO  70 

C . —SECTION  FOR  LOCIO=2,  RECALL  AND 

C  DISPLAY  FOR  MODEL  SUMMARY 

51  IS=IS+1 

CALL  PAGER(2) 

WRITE(LP*1020>  IFLD* (LIST( ILN* I ) *  1=3*5) * IVL*UNIT< 1 *ITYP) *SOURC( IS) 
IS=IS-1 

IF(L0CI0.NE,2)  GO  TO  80 
C . MIN/MAX  TEST 

53  CONTINUE 
IMN=IVAL(IX*2) 

IMX=IVAL(IX*3> 

IF(IVL.LT.IMN)  GO  TO  54 
IF(IVL.LE.IMX)  GO  TO  55 

54  WRITE(LP*2030)  IVL*IMN*IMX 
20300F0RMAT ( 24H  WARNING*  INPUT  VALUE  *  *15/ 

1  2?H  NOT  WITHIN  NOMINAL  RANGE  OF  ,15* 

2  4H  TO  *15) 
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55  CONTINUE 

56  CONTINUE 

57  IF< IS.LT t ISRC)  ISRC=IS 
RETURN 

70  IF(L0CI0.EQ.3)  GO  TO  71 
IF(IS.GT.l)  GO  TO  57 

71  CONTINUE 

72  WRITE(LP»2040>  (LIST ( ILN,  I ) ,1=3,5) 

2040  FORMAT  (25H  ENTER  INTEGER  VALUE  FOR  »3A4) 

IF ( .NOT .ENTR<0) )  GO  TO  51 
IF( .NOT >QUEST(0 ) )  GO  TO  99 
CALL  EXPLAIN(ILN) 

GO  TO  72 
99  CONTINUE 

IF ( .NOT . INTEGR( IVL) )  GO  TO  72 
IVAL( IX, 1 )=IVL 

LIST(ILN»2)=LIST(ILN»2)-IS+5 

IS=5 

GO  TO  53 

80  WRITE(LP»2050) 

2050  FORMAT  (31H  DO  YOU  WISH  TO  USE  THIS  VALUE?) 

IF<YESN0(0) )  GO  TO  53 
GO  TO  72 

: - ERROR  RETURN 

60  IERR=1 
ISRC=0 
IVL=0 
RETURN 

■» 

'lOOOOFORMAT  (5X>26H«**t«ERR0R  -  FIELD  NUMBER  ,I4,42H  REQUESTED  FOR  RECA 
ILL  HAS  NOT  BEEN  DEFINED/) 

10100F0RMAT  (5X»53H*****ERR0R  -  INTEGER  RECALL  REQUESTED  FOR  REAL  FIELD 
1  » 14 i 1X»3A4/) 

1020  FORMAT  <5X, 14, IX, 3A4.5H  =  ,I10,5X, A8,8K,  IS  A  ,A8,7H  VALUE/) 

END 

SUBROUTINE  ISVUFLD, IVL, ISRC) 

SUBROUTINE  ISV  SAVES  THE  VALUE  (IVL)  OF  AN  INTEGER  FIELD,  GIVEN 
BY  THE  FIELD  NUMBER  IFLD,  IN  THE  HACS  STATE  FILE  DEPENDING  ON 
THE  SOURCE  CODE.  THE  NEW  VALUE  IS  SAVED  IF  ITS  SOURCE  CODE 
(ISRC)  IS  GREATER  THAN  THE  SOURCE  CODE  OF  THE  VALUE  ALREADY 
STORED  IN  THE  STATE  FILE.  WHETHER  OR  NOT  THE  VALUE  IS  SAVED, 
THE  ROUTINE  PRODUCES  AN  OUTPUT  AUDIT. 

I  =  INTEGER  FORTRAN  ARRAY  INDEX 

IFLD  =  ARGUMENT,  FIELD  NUMBER  FOR  WHICH  VALUE  IS  TO  BE  SAVED 
ILN  =  INDEX  INTO  STATE  FILE  TO  OBTAIN  DEFINITION  OF  FIELD 

IS  *  SOURCE  CODE  FOR  VALUE  CURRENTLY  STORED  IN  STATE  FILE 

ISRC  =  ARGUMENT,  SOURCE  CODE  ASSOCIATED  WITH  VALUE  OF  FIELD 

TO  BE  SAVED 

ITYP  =  PRE-DEFINED  TYPE  OF  PHYSICAL  QUANTITY  FOR  FIELD  IFLD 
IVAR  =  TYPE  OF  INTERNAL  FIELD  STORAGE  FOR  FIELD  IFLD 
(0  FOR  INTEGER,  1  FOR  REAL) 

IVL  *  ARGUMENT,  GIVES  VALUE  OF  FIELD  IFLD  TO  BE  SAVED 

IX  *  INDEX  STORED  IN  STATE  FILE  TO  LINK  FIELD  DEFINITION 

TO  FIELD  VALUE  ARRAYS 

NFLD  *  (NI+NF)  GIVES  THE  TOTAL  NUMBER  OF  FIELD  DEFINITIONS 
ACTUALLY  STORED  IN  THE  STATE  FILE 

COMMON  VARIABLES  USED  -  IVAL, LIST, LP, NF, NI ,SOURC, UNIT 

SUBROUTINES  REQUIRED  -  PAGER 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  3  FEBRUARY  1976 


0C0MM0N/BASE/SAVE<2489) »UPTH< 15) ,HSG( 10) ,MNF,MNI , 
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1  NF,NI,LIST(275,6),FVAL(225,3),IVAL<50»3) 

INTEGER  UPTH 

REAL  NSG 

DIMENSION  STATE(248?) 

EQUIVALENCE  (STATE( 1 > ,MSG< 1 ) ) 

C 

C0MM0N/CNVDT/C0NV(3»47) »MSYS»MTYP»UNIT(4»47) 

C 

COMMON/HEAD/DTE, LNCT,LNPG,LP,NPG,TITLE( 10) 

C 

CONNON/NANE/PTLST ( 30 ) , SOURC ( 7 ) 

INTEGER  PTLST 


. LOOP  THROUGH  ALL  FIELD  DEFINITIONS  IN  STATE  FILE  TO  LOCATE 

FIELD  NUMBER  IFLD.  NOTE  THAT  AT  LEAST  ONE  FIELD  (FOR  CHEMICAL 
RECOGNITION  CODE)  BY  DEFINITION  HAS  BEEN  PREVIOUSLY  DEFINED* 
THE  VARIABLE  ILN  SAVES  THE  LOCATION  IN  THE  STATE  FILE 
CORRESPONDING  TO  FIELD  NUMBER  IFLD,  IF  FOUND. 

NFLD=NI+NF 
DO  10  1=1 »NFLD 
ILN=I 

IFdFLD.EQ  .LIST  (1,1))  GO  TO  20 
10  CONTINUE 


- ERROR.  THE  REQUESTED  FIELD  NUMBER  DOES  NOT  EXIST  IN  THE  HACS 

STATE  FILE.  THIS  CONDITION  INDICATES  EITHER  AN  ERROR  IN 
PROGRAM  CODING  OF  CALLS  TO  SUBROUTINE  ISV,  OR  A  MISSING 
DEFAULT  FILE  SPECIFICATION  TO  DEFINE  THE  FIELD  BEING  REQUESTED. 
CALL  PAGER(2) 

WRITE(LP,1000)  IFLD 
RETURN 


. -VERIFY  REQUEST  TO  SAVE  INTEGER  VARIABLE  WITH  STORAGE  MODE  OF 

VARIABLE  IN  STATE  FILE. 

20  IVAR=LIST < ILN,2)/1000 
IFdVAR.EQ.O)  GO  TO  30 

. ERROR.  INTEGER  VALUE  TO  BE  SAVED  FOR  VARIABLE  STORED  IN 

STATE  FILE  AS  A  REAL  VARIABLE. 

CALL  PAGER(2 ) 

WRITE (LP, 1010)  IFLD, (LIST (ILN, I)»I=3»5) 

10100F0RMAT  (5X  ,51H*m*ERR0R  -  INTEGER  SAVE  REQUESTED  FOR  REAL  FIELD 
1  I4,1X,3A4/) 

RETURN 


. FIELD  TYPE  IS  CORRECT, 

30  IS=1000*IVAR 

ITYP=(LIST(ILN, 2)-IS>/10 

IS=LIST(ILN,2)-10*ITYP-IS 

IX=LIST(ILN,4) 


UNPACK  CODES  FROM  STATE  FILE. 


. GENERATE  HACS  AUDIT  DISPLAY  FOR  FIELD  DEFINITION  AND  VALUE 

REQUESTED  TO  BE  SAVED.  NOTE  THAT  THE  VALUE  DISPLAYED  MAY 
NOT  BE  SAVED  IN  THE  STATE  FILE. 

CALL  PAGER<2> 

OWRITE(LP» 1020)  IFLD, (LIST ( ILN, I ) , 1=3,5) , IVL,UNIT( 1 , ITYP) » 

1  SOURC ( ISRC+1 > 


. GENERATE  WARNING  MESSAGE  IF  VALUE  TO  BE  SAVED  EXCEEDS  LIMITS. 

IFdVL .GE.  IVALdX ,2 )  .AND.  IVL.LE.  IVAL(IX*3) )  GO  TO  40 
CALL  PAGER(5) 

OWRITE(LP, 1030)  IFLD,  (LISTdLN,  I ) ,  1=3,5) , IVAL( IX,2> » IVAL( IX»3) » 

1  UNIT( 1 , ITYP) 


. COMPARE  SOURCE  CODE  OF  VALUE  TO  BE  SAVED  TO  SOURCE  CODE  OF 

VALUE  ALREADY  STORED  IN  STATE  FILE.  UPDATE  ONLY  IF  NEW  SOURCE 
CODE  EXCEEDS  PREVIOUS  SOURCE  CODE. 

40  IF ( ISRC.LT .IS)  GO  TO  50 

LIST(ILN,2)=LIST(ILN,2)+ISRC-IS 

IVALdX, 1)  =  IVL 

RETURN 
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. WRITE  NOTE  THAT  VALUE  DID  NOT  HAVE  HIGHER  SOURCE  CODE  AND  WAS 

NOT  PLACED  IN  THE  STATE  FILE. 

SO  CALL  PAGER<3) 

WRITE(LP* 1040)  IVAL( IX » 1 ) »UNIT ( 1 , ITYP) »S0URC ( IS+1 ) 

RETURN 

10000F0RNAT  <SX» 26H«***ERR0R  -  FIELD  NUMBER  ,I4,40H  REQUESTED  FOR  SAVE 
1  HAS  NOT  BEEN  DEFINED/) 

1020  FORMAT  (5X.I4, 1X.3A4.5H  =  ,I10,5X»A8,8H,  IS  A  ,A8,7H  VALUE/) 

10300F0RMAT  (5X,30Htm*WARNING  -  VALUE  OF  FIELD  ,I4,1X,3A4/ 

1  10X.47HREQUESTED  TO  BE  SAVED  EXCEEDS  NOMINAL  LIMITS  OF/ 

2  10X, I10,3X,4H  TO  ,  I10»5X» AB/10X.40HSUBSEQUENT  CALCULATIONS  MAY  N 
30T  BE  VALID/) 

10400F0RMAT  (5X»35H*****N0TE  -  VALUE  IN  STATE  FILE  OF  .I10.5X.A8/ 

1  10X.5HIS  A  .A8.27H  VALUE  AND  UAS  NOT  REPLACED/) 

END 

SUBROUTINE  LABELtX.ND, SCALE. NDIV) 

SUBROUTINE  LABEL  COMPUTES  AN  ARRAY  OF  AXIS  LABELS.  SCALE,  TO 
BE  USED  IN  PLOTTING  VALUES  OF  THE  VARIABLE  X  ALONG  A  SCALE 
DIVIDED  INTO  NDIV  INTERVALS.  THE  NUMBER  OF  DATA  POINTS  IN 
THE  ARRAY  X  IS  GIVEN  BY  ND.  THE  DIMENSION  OF  THE  ARRAY  SCALE 
MUST  BE  SET  IN  THE  CALLING  PROGRAM  AS  NDIV+1  OR  GREATER. 
SUBROUTINE  LABEL  ASSUMES  THAT  ND  IS  GIVEN  ON  INPUT  AS  2 
OR  GREATER.  IF  ND  IS  LESS  THAN  2,  ERRONEOUS  RESULTS  WILL 
BE  RETURNED. 

THE  ROUTINE  EMPLOYS  A  ROUNDING  TECHNIQUE  USED  BY  K.M.  WIIG 
AT  ADL  TO  PRODUCE  SMOOTH  AXIS  LABELS  BASED  SOLELY  ON  THE 
RANGE  OF  THE  DATA  TO  BE  PLOTTED,  NOT  PRE-DEFINED  INTERVAL 
SIZES.  THE  RANGE  OF  THE  PLOT  SCALE  PRODUCED  IS  ALWAYS  EQUAL 
TO  OR  GREATER  THAN  THE  RANGE  OF  DATA  VALUES  X. 

SEVERAL  PARAMETERS  ARE  USED  AND  VALUES  ARE  PRE-SET  IN  DATA 
STATEMENTS  TO  SIMPLIFY  ANY  ADJUSTMENTS  WHICH  MAY  BE  DESIRED. 

IN  PARTICULAR,  THE  PARAMETER  FAC  REPRESENTS  A  LIMITING  RATIO 
OF  THE  MINIMUM  VALUE  OF  X  TO  THE  MAXIMUM  VALUE.  IF  ALL  X  ARE 
POSITIVE,  BUT  XMIN  IS  LESS  THAN  FACtXMAX,  THE  ORIGIN  WILL 
AUTOMATICALLY  BE  INCLUDED  IN  THE  PLOT  SCALE. 


LOGDEL 

ND 


RLIMA 

RLIMB 

RND 

SCALE 

TENN 

TENN1 

TOL 


GIVES  THE  NOMINAL  RANGE  OF  THE  PLOT  SCALE  (XMAX-XMIN) 
MAXIMUM  PROPORTION  OF  PLOT  SCALE  ALLOCATED  TO  INCLUDE 
THE  ORIGIN  IF  ALL  X  ARE  POSITIVE 
INTEGER  LOOP  INDEX,  INTEGER  VARIABLE  FOR  ROUNDING 
OPERATION,  AND  MULTIPLE  OF  PROPORTIONAL  SPACING 
ARRAY  OF  DESIRED  PROPORTIONAL  SPACING  MULTIPLES,  WITH 
DATA  VALUES  SET  SUCH  THAT  IRND(I)  IS  GREATER  THAN 
OR  EQUAL  TO  I  FOR  I  LESS  THAN  OR  EQUAL  TO  20. 
INTEGER  LOOP  INDEX  OVER  NUMBER  OF  INTERVALS  NDIV 
DUMMY  SUBSCRIPT  (=J+1)  FOR  INDEXING  OUTPUT  SCALE 
FROM  2  TO  NDIV+1 

INTEGER  PART  OF  COMMON  LOGARITHM 

ARGUMENT,  NUMBER  OF  DATA  POINTS  GIVEN  IN  THE  ARRAY  X 
(VALUE  GIVEN  ON  INPUT  MUST  BE  2  OR  GREATER) 
ARGUMENT,  NUMBER  OF  DIVISIONS  OF  PLOT  SCALE  FOR  WHICH 
LABELS  ARE  DESIRED. 

LIMIT  VALUE  USED  TO  CORRECT  SMALL  NUMBER  ERROR 
LIMIT  VALUE  USED  TO  CORRECT  SMALL  NUMBER  ERROR 
VARIABLE  ROUND-OFF  FACTOR 

ARGUMENT,  OUTPUT  VALUES  ARE  DESIRED  AXIS  LABELS  FROM 
1  TO  NDIV+1 

TEN  RAISED  TO  THE  NTH  POWER 
TEN  RAISED  TO  THE  (N-l)  POWER 

SET  TOLERANCE  USED  TO  CANCEL  ROUND-OFF  IF  VALUE  IS 
VERY  CLOSE  TO,  BUT  ON  WRONG  SIDE,  OF  INTEGER  VALUE 
ARGUMENT,  ARRAY  OF  N  DATA  POINTS 
MAXIMUM  VALUE  OF  DATA  POINTS  X(I) 

MINIMUM  VALUE  OF  DATA  POINTS  X(I),  AND  ADJUSTED 
LOWER  LIMIT  OF  PLOT  SCALE 
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COMMON  VARIABLES  USED  -  NONE 

SUBROUTINES  REQUIRED  -  ABS. AL0G10, FLOAT 

AUTHORS-  K,M.  HIIG*  ARTHUR  D.  LITTLE.  INC., 

R.G.  POTTS  35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  16  OCTOBER  1975 

DIMENSION  IRND(20) *  SCALE < 1 ) ,X< 1 ) 

ODATA  (IRND( I) *1=1,20 )/l*2 *3 *4,5,6, 8, 8,1 0,10,1 2, 12,15, 15, 15? 

1  20,20,20,20,20/ 

DATA  FAC/0. 20/, RLIMA/0. 000000001/, RLIMB/0. 00000000001/ 

DATA  T0L/0. 00001/ 


- SEARCH  DATA  ARRAY  TO  OBTAIN  UPPER  AND  LOWER  BOUNDS 

XMIN=X( 1 ) 

XMAX=X( 1 ) 

DO  10  1=2, ND 

IF(XMIN.GT.X(I)>  XMIN=X(I ) 

IF(XMAX.LT . X( I ) )  XMAX=X< I ) 

10  CONTINUE 


- TEST  FOR  INCLUSION  OF  ORIGIN.  IF  SO,  SET  XMIN=0,  AND  JUMP 

TO  COMPUTE  AXIS  LABELS.  OTHERWISE  SET  UP  ROUND-OFF  FACTORS 
FOR  XMIN. 

IF(XMIN)  30,60,20 
20  IF(XMIN.GE.FAC*XMAX)  GO  TO  40 
XMIN=0.0 
GO  TO  60 
30  RND=T0L-1.0 
GO  TO  50 
40  RND=T0L 


. COMPUTE  LOWER  BOUND  OF  PLOT  SCALE.  OBTAIN  NOMINAL  RANGE  D, 

RESET  IF  SMALL  NUMBER  ERROR  OCCURS. 

50  D=XMAX-XMIN 

- ---OBTAIN* INTEGER!PART  OF  COMMON  LOGARITHM,  AND  COMPUTE  10«N-1, 

L0GDEL=AL0G10<D) 

TENN=10,**L0GDEL 

TENN1=TENN/10. 

. ROUND-OFF  LOWER  LIMIT  FOR  PLOT  SCALE 

XMIN=XMIN/TENN1 

I=XM1N4RND 

XMIN=I*TENN1 


. COMPUTE  RANGE  OF  PLOT  SCALE,  GET  NOMINAL  RANGE  AND  ADJUST 

FOR  VERY  SMALL  VALUES 
60  D=ABS(XMAX-XMIN) 

IF(D.LE.O.O)  D=RLIMB 

. OBTAIN  INTEGER  PART  OF  COMMON  LOGARITHM,  ADJUST  IF  D  IS  LESS 

THAN  1.0,  AND  COMPUTE  10**N 
LOGDEL-ALOGIO(D) 

IF(D.LT.l.O)  L0GDEL*L0GDEL-1 
TENNMO.MLOGDEL 

. COMPUTE  MULTIPLE  FOR  DESIRED  RANGE  FACTOR 

I *  <  20 . /FLOAT ( ND I V ) ) * ( D/TENN ) + l . O-TOL 

. REMOVE  COMMENT  ON  STATEMENT  BELOW  TO  USE  ARRAY  IRND  TO 

ELIMINATE  UNDESIRABLE  MULTIPLES  OF  I 
IF ( I.LT.20)  I=IRND( I ) 


. COMPUTE  COORDINATES  FOR  PLOT  AXIS  LABELING. 

SCALEU)«XMIN 

TENN=FL0AT<I)*TENN/20, 

DO  70  J*1 ,NDIV 
K*J+1 

70  SCALE(K>«XMIN4TENN»FL0AT<J) 

RETURN 
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c 


END 

SUBROUTINE  LINK 


SUBROUTINE  LINK  IS  A  DUMMY  ROUTINE  LOCATED  IN  THE  ROOT  OVER¬ 
LAY  WITH  REFERENCES  TO  COMMONLY  USED  EXTERNAL  LIBRARY 
FUNCTIONS,  THESE  REFERENCES  FORCE  THE  LOADING  OF  THESE 
ROUTINES  WITH  THE  MAIN  OVERLAY  INSTEAD  OF  MULTIPLE  OCCURRENCES 
OF  EACH  ROUTINE  IN  INDIVIDUAL  CALLING  OVERLAYS.  THE  PARAMETERS 
A,  B  AND  I  ARE  DUMMIES  USED  TO  ESTABLISH  FUNCTION  REFERENCES. 

COMMON  VARIABLES  USED  -  NONE 

SUBROUTINES  REQUIRED  -  (REFER  TO  PROGRAM  CODE  FOLLOWING) 

AUTHOR  -  R.G,  POTTS*  ARTHUR  D.  LITTLE.  INC.. 

35/309A  ACORN  PARK. 

CAMBRIDGE.  MASS..  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  16  OCTOBER  1975 

B=10. 

1  =  10 

A=ABS(B) 

A=ALOG(B) 

A=AL0G10(B) 

A=ATAN(B) 

A=COS(B) 

A=EXP(B> 

A=FLOAT ( I ) 

A=SQRT(B) 

RETURN 

END 

SUBROUTINE  LSTFL' ISW) 

SUBROUTINE  LSTFL  (FOR  LIST  FILE)  EXECUTES  THE  USER  SELECTED 
OPTION.  IF  ANY,  TO  DISPLAY  THE  CONTENTS  OF  THE  HACS  STATE 
FILE  AT  A  TIME  CORRESPONDING  TO  THE  ARGUMENT  ISM  - 

ISW  =  1  DISPLAY  FILE  CONTENTS  AFTER  INITIALIZATION 

ISW  =  2  DISPLAY  FILE  CONTENTS  AFTER  USER  INPUT 

ISW  =  3  DISPLAY  FILE  CONTENTS  AFTER  ASSESSMENT  RUN 

THE  ROUTINE  OBTAINS  FILE  OUTPUT  OPTIONS  FROM  THE  ARRAY  LSTCN 
WHOSE  CONTENTS  ARE  DETERMINED  BY  USER  CONTROL  INPUT.  OUTPUT 
IS  SUPPRESSED  IF  THE  OPTION  HAS  NOT  BEEN  SELECTED,  OR  IF  THE 
STATE  FILE  IS  UNDEFINED  OR  EMPTY.  SUBROUTINE  LSTFL  PERFORMS 
AN  OUTPUT  FUNCTION  ONLY,  NO  COMPUTED  VALUES  ARE  RETURNED  TO 
THE  CALLING  PROGRAM. 


CP 

D 

FAC 

I 

IFLD 

IN 

IPN 

ISRC 

ISW 


FLOATING  POINT  VALUE  OF  FIELD  RETRIEVED  FROM  STATE 
FILE,  AND  VALUE  CONVERTED  FOR  OUTPUT 
FLOATING  POINT  MINIMUM  VALUE  OF  FIELD  RETRIEVED  FROM 
STATE  FILE,  AND  VALUE  CONVERTED  FOR  OUTPUT 
FLOATING  POINT  MAXIMUM  VALUE  OF  FIELD  RETRIEVED  FROM 
STATE  FILE,  AND  VALUE  CONVERTED  FOR  OUTPUT 
FORTRAN  INTEGER  UNIT  NUMBER  FOR  CARD  PUNCH 
FIELD  CONVERSION  FACTOR  FOR  GIVEN  QUANTITY  TYPE  AND 
REQUESTED  OUTPUT  SYSTEM 

ARRAY  OF  UNIT  CONVERSION  FACTORS  FOR  TEMPERATURES 
DUMMY  INDEX,  AND  LOOP  THROUGH  FIELDS  DEFINED  IN  STATE 
FILE 

FIELD  NUMBER  RETRIEVED  FROM  STATE  FILE 
ARRAY  OF  OUTPUT  LABELS  TO  IDENTIFY  OPERATION  PRECEDING 
OUTPUT  DISPLAY 

CARD  PUNCH  OUTPUT  OPTION  COPIED  FROM  ARRAY  LSTCN 
(0  TO  SUPPRESS,  1  TO  SELECT) 

FIELD  VALUE  SOURCE  CODE  (0  TO  6)  RETRIEVED  FROM 
STATE  FILE 

ARGUMENT,  INDEXES  CONTENTS  OF  LSTCN  TO  OBTAIN  OPTIONS 
SELECTED,  IF  ANY,  FOR  DISPLAY  AT  POINTS  GIVEN  ABOVE 
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FOR  ISW  *  If  2f  OR  3 

ISYS  =  OPTION  SELECTED  BY  USER  FOR  OUTPUT  SYSTEM  OF  UNITS 
{VALUES  ARE  0=1 »  2.  3f  4) 

ITYP  =  FIELD  QUANTITY  TYPE  RETRIEVED  FROM  STATE  FILE 

IVAR  =  FIELD  STORAGE  TYPE  RETRIEVED  FROM  STATE  FILE 
<0  =  INTEGERf  1  =  REAL) 

IX  =  INDEX  RETRIEVED  FROM  STATE  FILEf  POINTS  TO  ARRAY 
LOCATIONS  GIVING  FIELD  VALUES 

J  =  DUMMY  ARRAY  INDEX 

JSRC  =  HAS  VALUE  OF  ISRC+1.  IN  RANGE  1  TO  7f  TO  INDEX  DATA 
ARRAY  OF  OUTPUT  LABELS. 

JSYS  =  HAS  VALUE  OF  ISYS-1  TO  INDEX  ARRAY  OF  CONVERSION 
FACTORS.  SYSTEM  1  GIVES  INTERNAL  UNITS.  AND 
CONVERSION  FACTORS  ARE  NOT  STORED. 

NFLD  =  TOTAL  NUMBER  OF  FIELDS  DEFINED  IN  STATE  FILE. 

TAG  =  TEMPORARY  STORAGE  OF  FIELD  UNIT  OUTPUT  LABEL 

COMMON  VARIABLES  USED  -  CONVfFVALfIVALfLBLfLISTiLPfLSTCNf 

HSGiNFfNIfSOURCfSTCONfUNIT 

SUBROUTINES  REQUIRED  -  PAGER 


AUTHOR  -  R.G.  POTTSf  ARTHUR  D.  LITTLE.  INC.. 

35/309A  ACORN  PARK. 
CAMBRIDGE.  MASS..  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  22  JANUARY  1976 


0C0MM0N/BASE/SAVE(2489) .UPTH( 15) . MSG( 10) fMNF.MNI . 

1  NFfNI.LIST(275f6)fFVAL(225f3).IVAL(50f3) 

INTEGER  UPTH 

REAL  MSG 

OCOMMON/CNTRL/EOFF . ICD. I DFLT » LBL ( 4 ) . LSTCN (3.3). MODEL  < 1 5 ) . NOP . 
1  STCON.SVCON 

INTEGER  EOFF. STCON.SVCON 
REAL  LBL 

C0MMON/CNVDT/C0NV(3.47)»MSYS.MTYP.(lNIT(4.47> 

COMMON/HEAD/DTE. LNCT.LNPG.LP.NPG. TITLE* 10) 

COMMON/NAME/PTLST (30) »S0URC(7) 

INTEGER  PTLST 


INTEGER  CP 

DIMENSION  FAC(3).IN(3.4) 

DATA  CP/62/ 

DATA  (F AC  (I).l  =  l»3)/1, 0.1. 8.1,0/ 

DATA  (IN(1»I)»I=1»4)/4HINIT,4HIALI .4HZATI »4H0N  / 

DATA  (IN(2»I)»I=1»4)/4HUSER»4H  INP.4HUT  »4H  / 

DATA  (IN(3.I).I=1»4)/4HASSE.4HSSME.4HNT  R.4HUN  / 


- TEST  FOR  REQUESTED  LIST  OPTION  AND  RETURN  IF  NOT  SELECTED 

IF(LSTCNdSN.l).EQ.O)  RETURN 

. WRITE  HEADER  FOR  OPTION  SELECTED  AND  FILE  TYPE 

IF(ISW.NE.l)  CALL  PAGER (0) 

CALL  PAGER(3) 

WRITE(LP.IOOO)  ( IN( ISW. I ) .1=1 .4 ) 

CALL  PAGER* 1) 

WRITE(LP.IOIO)  LBL(STCON) 

- IF  STATE  FILE  IS  UNDEFINED  OR  EMPTY.  SKIP  OUTPUT  WITH  MESSAGE 

AND  RETURN 

IF(STCON.LE.l)  GO  TO  10 
NFLD=NF+NI 

IF(NFLD.GT.l)  GO  TO  20 
10  CALL  PAGER(3> 
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WRITE(LPf 1020) 
RETURN 


. RETRIEVE  FILE  DISPLAY  OPTIONSf  OVERRIDE  DEFAULT  FOR  UNIT 

SELECTION 

20  ISYS=LSTCN( ISUf2) 

IF( ISYS.EQ.O)  ISYS=1 
JSYS=ISYS-i 
IPN=LSTCN ( ISU  >  3 ) 


-—WRITE  STATE  FILE  HEADER 
CALL  PAGER(2) 

WRITE<LPi 1030)  MSG 
IF(IPN.EO.l)  WRITE!CPf1040)  MSG 
CALL  PAGER (3) 

WRITE!LPf1050) 

CALL  PAGER(3) 

WRITE(LPf 1060) 


- LOOP  ON  NUMBER  OF  FIELDS  DEFINED  IN  FILE 

DO  60  1=1 f NFLD 


- UNCODE  DATA  FROM  STATE  FILE  FOR  FIELD  IN  LIST  POSITION  I 

IFLD=LIST ( I  f  1 ) 

IVAR=LIST(I f2)/1000 

ISRC=1000*IVAR 

ITYP=(LIST(If2)-ISRC)/10 

ISRC=LIST ( I f2)-10*ITYP-ISRC 

JSRC=ISRC+1 

IX=LIST  ( I  f6  ) 

TAG=UNIT(ISYS»ITYP) 


- IF  FIELD  IS  REALf  ftppLY  OUTPUT  CONVERSION  AND  DISPLAY 

IF ( IVAR.EQ.O)  GO  TO  40 
A=FVAL(IXf1) 

B=FVAL!IXf2) 

C=FVAL( IXf3) 

IF(JSYS.LE.O)  GO  TO  30 
D=CONV( JSYSf ITYP) 

. —BRANCH  FOR  TEMPERATURE  CONVERSION  EQUATION 

IF ( ITYP .EQ .6)  GO  TO  25 

A=A/D 

B=B/D 

C=C/D 

GO  TO  30 

25  A=D+A*FAC( JSY5) 

B=D+B*FAC(JSYS) 

C=DFC*FAC( JSYS  ) 

30  CALL  PAGER < 1 ) 

OWRITE(LP» 1070)  IFLDf A fTAGf IVARfISRCfSOURC! JSRC) fBfCf 
1  ITYPf(LIST!IfJ)fJ=3f5) 

OIF ( IPN.EQ . 1 )  URITE(CPf 1080)  IFLDf AfTAGf IVARfBfCf 
1  ITYPf(LIST(IfJ)fJ=3f5) 

GO  TO  60 


. FOR  INTEGER  FIELDSf  DISPLAY  ALL  FIELDS  IN  SAME  FORMAT  EXCEPT 

FOR  FIELD  IOOIf  CHEMICAL  RECOGNITION  CODE 
40  IF ( IFLD.NE. 1001 )  GO  TO  50 
CALL  PAGER! 1 ) 

OWRITE(LPf 1090)  IFLDf IVAL! IXf 1 ) fTAGf IVARf ISRCf 
1  SOURC(JSRC) fITYPf(LIST(IfJ)fJ=3f5) 

IF(IPN.EQ.l)  WRITE(CPfHOO)  IFLDf IVAL( IXf 1 ) fTAG 
GO  TO  60 

50  CALL  PAGER! 1) 

OWRITE!LPf 1110)  IFLDf IVAL! IXf 1 ) fTAGf IVARf ISRCf 
1  SOURC! JSRC) f IVAL! IXf  2) f IVAL (IX»3)fITYPf!LIST!IfJ)fJs3f5) 

OIF!IPN.EQ.l)  WRITE(CPf1120>  IFLDf IVAL!IXf 1 ) fTAGf IVARf 
1  IVAL! IXf2) f IVAL ! IXf 3) f ITYP f (LIST! I f J) f J=3f5) 

60  CONTINUE 
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: . WRITE  MESSAGE  IF  CARD  DECK  WAS  PUNCHED 

CALL  PAGER<3) 

IF(IPN.EQ.l)  WRITE(LP»1130) 

IF ( ISW.EQ • 1 )  CALL  PAGER(O) 

RETURN 

% 

'lOOOOFORMAT  <//5X,49H0PTI0N  SELECTED  TO  DISPLAY  MACS  STATE  FILE  AFTER  * 
1  4A4) 

1010  FORMAT  (10X» 14HFILE  CONTAINS  *A8*7H  VALUES) 

10200F0RHAT  <10X*52HSTATE  FILE  IS  UNDEFINED  -  OUTPUT  HAS  BEEN  SUPPRESSE 
ID//) 

1030  FORMAT  <10X*20HFILE  LABEL  FOLLOWS  -/20X*10A8> 

1040  FORMAT  (10A8) 

1050  FORMAT  <10X*22HFILE  LISTING  FOLLOWS  -//> 

10600F0RMAT  < 10X*5HFIELD*30X* 19H0= INTEGER  SOURCE. 38X*7HTYPE  0F/10X* 

1  41HNUMBER  FIELD  VALUE  UNIT  1=REAL.8X* 4HC0DE*5X* 

2  55HN0MINAL  MINIMUM  NOMINAL  MAXIMUM  QUANTITY  FIELD  NAME/ 

3  10X*6(1H-)*2X*15(1H-)*2X*8(1H-)*2X*9(1H-)*2X*10(1H-)*2X*15(1H-)* 

4  2X*15(1H-)*2X*8(1H->*2X*12<1H-)) 

10700F0RMAT  ( 11X* 14* 3X.G15 .4 ,2X* A8*2(6X*I 1 ) * 1H=, A8»2(2X,G15.4) ,5X, 

1  I2*5X*3A4) 

1080  FORMAT  <I4*G15.4»A8*I1»1H3*2G15.4*I2* 3A4) 

10900F0RMAT  ( 11X. I4.3X, A4* 13X* A8.2(4X. II ) * 1H=* A8*2(2X* 3HN/A* 12X) *5X* 

1  I2*5X*3A4) 

1100  FORMAT  (I4»A4f 11X»A8) 

11100F0RMAT  (llXjI4»8X»I10>2X»A8»2(6XjIl)>lH=jA8»2(7X»I10)f5XjI2» 

1  5X  f 3A4 ) 

1120  FORMAT  ( 14 > 5X* I 10 » A8. II t 1H3 . 2<5X» 110) » I2f 3A4 ) 

1130  FORMAT  <//10X»34HSTATE  FILE  DATA  CARDS  WERE  PUNCHED) 

END 

SUBROUTINE  OUTPR(NAME) 

THIS  SUBROUTINE  PRINTS  A  MESSAGE  TO  INDICATE  THAT  THE  OUTPUT 
FROM  A  RATE  MODEL  FOLLOWS. 


SUBROUTINES  REQUIRED  -  PAGER 

CALL  PAGER(5) 

WRITE(6>100)  NAME 
RETURN 

100  FORMAT ( //21H  THE  RESULTS  OF  MODEL »A4»  7H  ARE...//) 

END 

SUBROUTINE  OVLOD(NOV) 

INTERFACE  ROUTINE  TO  OVERLAY  LOAD  FUNCTION  WHERE  NOV  GIVES 
THE  NUMBER  OF  THE  OVERLAY  TO  BE  LOADED.  ALL  CALLS  TO  THE 
OVERLAY  LOAD  FUNCTION  ARE  LOCATED  IN  THE  HACS  MAIN  PROGRAM 
WHICH  ITSELF  IS  PART  OF  OVERLAY  0.  NOTE  THAT  SINCE  OVERLAY 
0  IS  RESIDENT  THROUGHOUT  EACH  EXECUTION*  A  CALL  OVLOD(O)  HAS 
BEEN  DISABLED.  OVERLAY  SELECTION  IS  BASED  ON  THE  USE  OF  A 
DATA  ARRAY  OVLST  WHICH  IS  INDEXED  BY  THE  INTEGER  RATE  MODEL 
EQUIVALENT  MODNO.  OVERLAY  ALLOCATION  TO  RATE  MODELS  IS 
DETERMINED  BY  THE  LOCATION  OF  PROGRAM  CODE  AND  DATA  ELEMENTS 
OF  OVLST.  PRE-DEFINED  OVERLAY  ALLOCATIONS  ARE  AS  FOLLOWS  - 
0  =  MAIN  HACS  CONTROL  PROGRAM  AND  ALL  FREQUENTLY 

USED  GENERAL  PURPOSE  HACS  AND  SYSTEM 
LIBRARY  ROUTINES 

1  =  HACS  INPUT  DATA  PROCESSOR 

2  *  NOT  USED  (FORMERLY  ALLOCATED  TO  HACS  X-Y 

GRAPHIC  OUTPUT  PROCESSOR) 

COMMON  VARIABLES  USED  -  NONE 
SUBROUTINES  REQUIRED  -  UFOVER 


AUTHOR  -  R.G.  POTTS*  ARTHUR  D.  LITTLE*  INC.* 

35/309A  ACORN  PARK* 
CAMBRIDGE*  MASS.*  02140 
TEL.  617-844-5770  EXT.  2813 
DATE  -  16  OCTOBER  1975 

IF(NOV.LE.O)  RETURN 
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CALL  0V£RLAY(6HUIMABS,N0V»0»6HRECALL ) 

RETURN 

END 

SUBROUTINE  PAGER(LINES) 

SUBROUTINE  COMPARES  THE  NUMBER  OF  OUTPUT  LINES  TO  BE  WRITTEN 
ON  UNIT  LP ,  SPECIFIED  BY  THE  ARGUMENT  LINES.  TO  THE  NUMBER  OF 
LINES  REMAINING  ON  THE  PAGE.  LNPG-LNCT.  AND  WRITES  A  HEADER 
AT  THE  TOP  OF  A  NEW  PAGE  WHEN  INSUFFICIENT  SPACE  IS  LEFT  TO 
WRITE  A  BLOCK  OF  LENGTH  LINES.  A  NEW  PAGE  MAY  BE  FORCED  BY 
CALLING  THE  ROUTINE  WITH  LINES  SET  TO  ZFRO  AS  THE  ARGUMENT, 
THE  HEADER  LINE  PRODUCED  CONSISTS  OF  AN  80  CHARACTER  TITLE. 
DATE  AND  PAGE  NUMBER.  THE  PAGE  NUMBER  IS  AUTOMATICALLY 
UPDATED  BY  THIS  ROUTINE. 


LINES  =  NUMBER  OF  OUTPUT  LINES  TO  BE  WRITTEN  IMMEDIATELY 
FOLLOWING  CALL  TO  PAGER 

TIME  =  TIME  OF  DAY  OBTAINED  FROM  SYSTEM  LIBRARY  MACRO  AS 
24— HOUR  CLOCK  READING  IN  A8  FORMAT  AS  HH/MM/SS 

COMMON  VARIABLES  USED  -  DATE, LNCT.LNPG.LP.NPG. TITLE 

SUBROUTINE  REQUIRED  -  TMDY 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 

DATE  -  27  MAY  1975 

COMMON/HEAD/DTE, LNCT.LNPG.LP.NPG. TITLE! 10) 


. -TEST  FOR  TOP  OF  FORM  COMMAND.  I.E.,  CALL  PAGER(O) 

IF (LINES , EQ. 0)  GO  TO  10 

. —INCREMENT  CUMULATIVE  LINE  COUNT  WITH  NUMBER  OF  LINES  TO  BE 

WRITTEN  FOLLOWING  CALL  AND  COMPARE  TO  PAGE  LIMIT.  RETURN  IF 
LESS  THAN  LIMIT. 

LNCT=LNCT+LINES 
IF(LNCT.LE.LNPG)  RETURN 

- PAGE  LIMIT  REACHED  OR  EXCEEDED.  INCREMENT  PAGE  COUNTER,  WRITE 

HEADER  AND  SET  LINE  COUNT  TO  NUMBER  OF  LINES  IN  HEADER  PLUS 
OUTPUT  LINES  FOLLOWING, 

10  NPG*NPG+1 

CALL  TIME(TIM) 

WRITE(LP.IOOO)  DTE, TIM, NPG. TITLE 

LNCT*LINES+6 

RETURN 

10000F0RMAT  (46H1HAZARD  ASSESSMENT  COMPUTER  SYSTEM  (HACS)  DATE-AIO, 

1  1X»4HTIHE,A9,2X,4HPAGE, I3//1X.9A8, A7/1X,79( 1H*)//) 

END 

SUBROUTINE  PLTLP(PTITL»X,Y,N,XTITL,YTITL,II .DIV.XTITLl ) 

SUBROUTINE  PLTLP  PRODUCES  A  ONE  PAGE  40  BY  80  LINE  PRINTER 
PLOT  OF  THE  DATA  POINTS  (X(J).Y(J)).  J*1»N.  THE  ARGUMENTS 
TO  THE  ROUTINE  PROVIDE  FOR  A  PLOT  TITLE,  IDENTIFICATION  ALONG 
EACH  AXIS  AND  AN  OPTION  TO  PRODUCE  A  DOUBLE  SET  OF  LABELS 
FOR  THE  X-AXIS.  ALL  LABEL  ARRAYS  ARE  STANDARDIZED  AT  48 
CHARACTERS  (6A8)  EACH  AND  MAY  BE  USED  FOR  LABELS,  DIMENSIONS 
OR  OTHER  INFORMATION.  THE  Y-AXIS  LABEL  IS  SPLIT  INTO  THREE 
PARTS  OF  16  CHARACTERS  EACH  TO  KEEP  THE  FINISHED  PLOT  WTi'-;iN 
AN  8,5  BY  11  INCH  LIMIT,  SMOOTH  AXIS  LABELING  IS  PERFORiltD 
BY  SUBROUTINE  LABEL. 

EXACTLY  N  DATA  POINTS  ARE  PLOTTED  AS  SPECIFIED  BY  THE 
ARGUMENTS  X  AND  Y.  NO  DATA  SMOOTHING  OR  INTERPOLATION  IS 
PERFORMED  BY  THIS  ROUTINE.  THERE  ARE  NO  RESTRICTIONS  ON  THE 
FORM  OF  THE  FUNCTION  REPRESENTED  BY  X  AND  Y, 


46 


non  oo  ooorjoorjorjoooooooooooooooorDOoooooooooonooooonorjooooooooo  r> 


BUFF  =  81  CHARACTER  PRINT  BUFFER  WITH  A  PLOT  SYMBOL  SET  AT 
EACH  RELATIVE  X  POSITION  FOR  ANY  BATA  POINT  HAVING 
A  VALUE  OF  Y  CORRESPONDING  TO  NY 
DIV  =  ARGUMENT,  A  FACTOR  WHICH  GIVES  THE  RELATIONSHIP 
BETWEEN  THE  TWO  X  AXES  TO  BE  PRINTED  IF  11=1. 

THE  LABELS  GENERATED  FOR  THE  FIRST  X  AXIS  ARE 
DIVIDED  BY  DIV  TO  PRODUCE  THE  LABELS  FOR  THE 
QFrnNn  aytq 

DX  =  COMPUTED  GRID*SIZE  ALONG  X-AXIS 

DY  =  COMPUTED  GRID  SIZE  ALONG  Y-AXIS 

IBLNK  =  INTEGER  DATA  WORD  CONTAINING  BLANKS  (A4>  USED  TO 
INITIALIZE  PRINT  BUFFER 

II  =  ARGUMENT,  SWITCH  USED  TO  SELECT  (11=1)  OR  SUPPRESS 
(11=0)  PRINTING  OF  SECOND  X  AXIS 
ISW  =  ALTERNATING  VARIABLE  (+1,-1)  USED  FOR  FORMAT  CONTROL 
ON  ALTERNATING  LINES 
J  =  INTEGER  INDEX,  GENERAL 

JY  =  INTEGER  INDEX  DECREMENTED  TO  DISPLAY  Y  AXIS  LABELS 
FROM  TOP  OF  PAGE  DOUN 

KX  =  COMPUTED  INTEGER  POSITION  IN  PRINT  BUFFER  WHICH 
CORRESPONDS  TO  X  COORDINATE  OF  DATA  POINT 
KY  =  COMPUTED  INTEGER  POSITION  ALONG  VERTICAL  SCALE 

WHICH  CORRESPONDS  TO  Y  COORDINATE  OF  DATA  POINT 
N  =  ARGUMENT,  NUMBER  OF  DATA  POINTS  TO  BE  DISPLAYED 

NY  =  INTEGER  INDEX  CORRESPONDING  TO  VERTICAL  SCALE,  VARIES 
FROM  41  TO  1  FROM  THE  TOP  DOWN 
NYY  =  DUMMY  INDEX  LOOP  FROM  1  TO  41  USFD  TO  OBTAIN  NY 
PLOT  =  SYMBOL  USED  FOR  DATA  POINT  DISPLAY 
PTITL  =  ARGUMENT,  48  CHARACTER  PLOT  TITLE 

X  =  ARGUMENT ,  ARRAY  OF  VALUES  OF  X  COORDINATES,  N  POINTS 

XMAX  =  UPPER  LIMIT  OF  X  AXIS  (IS  GENERALLY  EQUAL  TO  OR 

GREATER  THAN  THE  MAXIMUM  OF  X ( J > ) 

XMIN  =  LOWER  LIMIT  OF  X  AXIS  (IS  GENERALLY  EQUAL  TO  OR 
LESS  THAN  THE  MINIMUM  OF  X(J)> 

XSCL  =  ARRAY  OF  VALUES  FOR  LABELS  ALONG  FIRST  ABSCISSA 

XSCL1  =  ARRAY  OF  VALUES  FOR  LABELS  ALONG  SECOND  ABSCISSA 

XTITL  =  ARGUMENT,  48  CHARACTER  TITLE  FOR  FIRST  ABSCISSA 
XTITL1  =  ARGUMENT,  48  CHARACTER  TITLE  FOR  SECOND  ABSCISSA 
Y  =  ARGUMENT,  ARRAY  OF  VALUES  OF  Y  COORDINATES,  N  POINTS 

YMAX  =  UPPER  LIMIT  OF  Y  AXIS  (SEE  XMAX) 

YMIN  =  LOWER  LIMIT  OF  Y  AXIS  (SEE  XMIN) 

YSCL  =  ARRAY  OF  VALUES  FOR  LABELS  ON  ORDINATE 
YTITL  =  ARGUMENT,  48  CHARACTER  TITLE  FOR  ORDINATE 

COMMON  VARIABLES  USED  -  LP 

SUBROUTINES  REQUIRED  -  LABEL, PAGER 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  16  OCTOBER  1975 

REVISION  -  12  MARCH  1980  (SCALE  TO  80  CHAR  PLOTS) 

COMMON/HEAD/DTE, LNCT,LNPG,LP,NPG, TITLE (10) 

ODINENSION  BUFF (61),PTITL(6),X(1 > ,XSCL(7) ,XSCL1 (7) , XTITL (6), 

1  XTITL 1(6), Y(1 ) , YSCL (21),YTITL(6) 

INTEGER  BUFF, PLOT 

EQUIVALENCE  (XMIN,XSCL< 1 ) ) , (XMAX, XSCL (7) ) 

EQUIVALENCE  ( YMIN, YSCL< 1 > ), (YMAX, YSCL (21 ) ) 

DATA  IBLNK/4H  /,PL0T/4H0  / 


- SET  UP  X  AND  Y  AXES  FOR  EVEN  LABELS  AND  COMPUTE  GRID  SIZES 

CALL  LABEL(X,N,XSCL,6) 

DX=(XMAX-XMIN)/60. 

CALL  LABEL(Y»N,YSCL,20) 

DY=(YHAX-YMIN)/40. 
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C 

c- 


- WRITE  PLOT  TITLE  AND  AXIS  LINE 

CALL  PAGER  (0) 

WRITE (LP» 1000)  (YTITL(I),I=1,4),(PTITL(I),I=1,6),YTITL(5),YTITL(6) 
WRITE(LP» 1010) 


. SET  UP  AND  LOOP  ON  Y  SCALE. 

JY=22 

ISW=-1 

DO  70  NYY=1 *41 
NY=42-NYY 
ISW=-ISW 
DO  10  J=1 f 61 
10  BUFF( J)=IBLNK 


CLEAR  PRINT  BUFFER  EACH  TIME 


-LOOP  THROUGH  ALL  DATA  POINTS.  IF  Y  COORDINATE  MATCHES 


CURRENT  PRINT  LINE* 
TO  X  COORDINATE. 

DO  20  J=1  *N 
KY=(Y(J)-YMIN)/DY+1.5 
IF(KY.NE.NY)  GO  TO  20 
KX=<X( J)-XNIN)/DXF1.5 
BUFF(KX )=PL0T 
20  CONTINUE 


SET  PLOT  SYMBOL  IN  POSITION  CORRESPONDING 


- SELECT  TYPE  OF  PRINT  LINE 

IF(ISW.LT.O)  GO  TO  30 
JY=JY-1 

WRITE(LP» 1020)  YSCL( JY) »BUFF 
GO  TO  70 
30  CONTINUE 

WRITE(LP* 1030)  BUFF 
70  CONTINUE 


- CLOSE  OFF  PLOT  WITH  SINGLE  OR  DOUBLE  X-AXIS  LABELS 

WRITE(LP» 1040 ) 

WRITE(LP,  1060)  XSCLrXTITL 
IF(II.EQ.O)  RETURN 
DO  80  J=1 »7 

80  XSCL1 ( J)=XSCL( J)/DIV 

WRITE( LP *  1060 )  XSCL1.XTITL1 
RETURN 

- BLANK  SUBSTITUTED  FOR  + 

1000  FORMAT  <///lX,2A8/lX*2A8,9X*6AB/lX*2A8/4X,7(9X,lH  )) 

- BLANK  SUBSTITUTED  FOR  * 

1010  FORMAT  (12X.63UH  )) 

- TWO  BLANKS  SUBSTITUTED  FOR  *+ 

1020  FORMAT  (IX* 1PE9.2*3H  +*,61A1*2H  > 

. BLANK  SUBSTITUTED  FOR  * 

1030  FORMAT  ( 12X* 1H**61A1 * 1H  ) 

1040  FORMAT  ( 12X , 63 ( 1H*) ) 

1060  FORMAT  <4X,7(9X* 1H+ >/7X,7< IX* 1PE9.2)/19X*6A8) 

END 

SUBROUTINE  SEGLOD(NSEG) 

INTERFACE  ROUTINE  TO  SEGMENT  LOAD  FUNCTION  WHERE  NSEG  GIVES 
THE  NUMBER  OF  THE  SEGMENT  TO  BE  LOADED.  ALL  CALLS  TO  THE 
SEGMENT  LOAD  FUNCTION  ARE  CODED  WITHIN  EACH  OVERLAY  REQUIRING 
SEGMENTS*  AND  THE  SELECTION  IS  USUALLY  BASED  ON  THE  RATE  MODEL 
INDEX  MODNO.  THE  SEGMENT  INDEX  LIST  SGLST  ORIGINALLY  DEFINED 
FOR  THIS  PURPOSE  IS  NOT  GENERALLY  USED. 

COMMON  VARIABLES  USED  -  NONE 

SUBROUTINES  REQUIRED  -  UFSEG 

AUTHOR  -  R.G.  POTTS*  ARTHUR  D.  LITTLE*  INC.* 

35/309A  ACORN  PARK, 

CAMBRIDGE*  MASS.*  02140 
TEL.  617-864-5770  EXT.  2813 
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DATE  -  16  OCTOBER  1975 

IF(NSEG.LE.O)  RETURN 

CALL  OVERLAY ( 6HUI MABS , 8, NSEB , 6HRECALL ) 

RETURN 

END 

SUBROUTINE  TOXICtC, IFLAG,AM, XCONC) 

THIS  SUBROUTINE  CONVERTS  CONCENTRATIONS  OF  A  VAPOR  IN  AIR  FROM  UNI 
OF  GM/CMW3.  TO  UNITS  OF  PPM  OR  MOLE  PERCENT 


mtINPUTS 

C 

IFLAG 


MMOUTPUTS 


THE  CONCENTRATION  IN  GM/CMW3.  WHOSE  UNITS  ARE  TO  BE  CONVE 
FLAG  INDICATING  WHETHER  DESIRED  OUTPUT  IS  TO  BE  IN  UNITS  0 
PPM  OR  MOLE  PERCENT.  IFLAG=0  FOR  MOLE  PERCENT » IFLAG-1  FO 
MOLECULAR  WEIGHT  OF  THE  CHEMICAL 


XCONC  THE  CONCENTRATION  DESIRED  IN  EITHER  UNITS  OF  MOLE  PERCENT 

DENA=0. 0012894 
DENV=AM/22414. 

XC0NC=1 ./( 1 .+< <AM/28.9)t(DENA/C)f ( 1 .-(C/DENV) ) ) ) 

IF < IFLAG-O)  20.20.10 
10  XCONCsXCONCf 1000000. 

GO  TO  30 

20  XC0NC=XC0NC*1 00. 

30  RETURN 
END 

SUBROUTINE  TRACE(ISW.NOV.NSEG) 

SUBROUTINE  TRACE  PROVIDES  LINE  PRINTER  MESSAGES  FOR  DIAGNOSTIC 
TESTING  OF  MACS  OVERLAY  FUNCTION.  SUBROUTINE  CALLS  ARE  CODED 
AT  THE  BEGINNING  AND  END  OF  EACH  OVERLAY  TO  BRANCH  TO  THIS 
ROUTINE  TO  SELECT  AN  AUDIT  MESSAGE  FOR  THE  STATUS  OF  EACH 
OVERLAY  AND  SEGMENT.  A  RETURN  STATEMENT  HAS  BEEN  INSERTED  AS 
THE  FIRST  EXECUTABLE  STATEMENT  TO  OVER-RIDE  THIS  DIAGNOSTIC 
FUNCTION  FOR  USER  RUNS. 

ISW  =  MESSAGE  CONTROL  SWITCH,  0  TO  FORCE  STARTING  MESSAGE, 

1  TO  SELECT  ENDING  MESSAGE 
NOV  =  OVERLAY  NUMBER  SET  IN  CALLING  PROGRAM 

NSEG  =  SEGMENT  NUMBER  SET  IN  CALLING  PROGRAM 

COMMON  VARIABLES  USED  -  LP 

SUBROUTINES  REQUIRED  -  PAGER 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  2  DECEMBER  1975 

COMMON/HEAD/DTE, LNCT,LNPG,LP,NPG, TITLE (10) 

RETURN 

CALL  PAGER(l) 

IF( ISW.EQ. 1 )  GO  TO  10 
WRITE(LP.IOOO)  NOV, NSEG 
RETURN 

10  WRITE(LP.IOIO)  NOV, NSEG 
RETURN 


lOOOOFORMAT  <5X,42Htm*0VERLAY  TRACE,  NOW  EXECUTING  OVERLAY  ,12, 
1  9H  SEGMENT  ,12) 

10100FORMAT  <5X,37H*m*0VERLAY  TRACE,  FINISHED  OVERLAY  ,12, 

1  9H  SEGMENT  ,12) 

END 
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LOGICAL  FUNCTION  ENTR(J) 

C  READS  TERMINAL  INPUT  INTO 

C  BUFFER  FOR  CHARACTER  SCAN 

OC0MMQN/INTER/'BLANK,BUFF(80),CHAR»IN,N0, 

1  NUN, OUT  , PTR .SPLST ( 14 ) ,  TYP , YES 
INTEGER  BLANK, BUFF, CHAR .DEC, EXP 
INTEGER  OUTfPLUS* PTR* SPLST* TYP* YES 
EQUIVALENCE  (DEC. SPLST ( 13)  )*  (EXP. SPLSTU4) ) 
EQUIVALENCE  (MINUS. SPLST ( 12) ) . (PLUS. SPLST ( 11 ) ) 

C- . CLEAR  EOF  INDICATOR 

IN=5 

IF(EOF ( IN) )  10.10 

C . INITIALIZE  BUFFER 

10  DO  20  1=1.80 
20  BUFF( I)=BLANK 

READ(IN.IOOO)  BUFF 
PTR=0 

C . . SEE  IF  INPUT  FOUND 

30  IF(NEXT(0) )  30.40.50 
40  ENTR=. FALSE. 

RETURN 

50  ENTR= .TRUE. 

PTR=0 

RETURN 

1000  FORMAT  (80A1) 

END 

LOGICAL  FUNCTION  FLTPT (VALUE) 

C . —RETURNS  .TRUE.  WITH  VALID  REAL  NUMBER  AS  VALUE 

C . . .FALSE.  OTHERWISE 

OCOMMON/ INTER/BLANK. BUFF (80) .CHAR. IN .NO. 

1  NUM.OUT . PTR. SPLST ( 14) .TYP.YES 
INTEGER  BLANK. BUFF. CHAR. DEC. EXP 
INTEGER  OUT, PLUS. PTR, SPLST, TYP. TES 
EQUIVALENCE  < DEC , SPLST ( 13) ) , (EXP, SPLST ( 14 ) ) 
EQUIVALENCE  (MINUS, SPLST(  12) ) ,  (PLUS,  SPLST  (ID) 
LOGICAL  INTEGR 

C . INITIALIZE  FOR  VALID  RETURN 

FLTPT= .TRUE. 

C . —SKIP  TO  NEXT  NON-BLANK  INPUT  CHARACTER 

10  IF(NEXT(0 ) )  10,150,20 

C . -INITIALIZE 

20  TEMP=0.0 
VALUE=0.0 
ISIGN=1 

C . . CHECK  FOR  OPTIONAL  SIGN 

IF < CHAR. EQ. PLUS)  GO  TO  30 
IF(CHAR.NE. MINUS)  GO  TO  40 
ISIGN=-1 

C— . NEED  NEXT  INPUT.  MAY  BE  DECIMAL  POINT  OR  DIGIT 

30  IF(NEXT(0>)  150,150,40 
40  IF(TYP.NE.l)  GO  TO  50 

C . —PROCESS  DIGITS  PRECEEDING  DECIMAL  POINT 

TEMP=10.*TEMP+NUM 
IFtNEXT (0) )  130,130,40 

C . CHECK  FOR  DECIMAL  POINT  OR  EXPONENT 

50  IF (CHAR. EQ. EXP)  GO  TO  75 
IF (CHAR.NE.DEC)  GO  TO  140 
PT=1 .0 

C . PROCESS  DIGITS  FOLLOWING  DECIMAL  POINT 

60  IF(NEXT (0) )  130,130,65 
65  IF(TYP.NE.l)  GO  TO  70 
PT=PT/10, 

TENP=TEMP+PT*NUM 
GO  TO  60 

C . TEST  AND  PROCESS  OPTIONAL  EXPONENT 

70  IF(CHAR.NE.EXP)  GO  TO  140 
75  IF ( .NOT . INTEGR ( IEXP) )  GO  TO  150 
IF(IEXP)  80,130,90 
80  EXBS=0. 1 
IEXP=-IEXP 
GO  TO  100 
90  EXBS=10. 
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100  DO  110  J*1»IEXP 
110  TEMP*TEMPtEXBS 

C . STORE  RESULT  AND  RETURN 

130  VALUE*TEMP*ISIGN 
RETURN 

C . BAD  CHARACTER  ERROR.  ADVANCE  TO  BLANK  OR  EOR 

140  IF(N£XT(0) )  150.150.140 

C . ERROR  ON  BLANK  OR  EOR 

150  FLTPT*. FALSE. 

0UT=6 

WRITE (OUT . 1000) 

RETURN 

1000  FORMAT  (29H  WHAT?  (DECIMAL  SYNTAX  ERROR)) 

END 

LOGICAL  FUNCTION  INTEGR(IRESLT) 

C . RETURNS  .TRUE.  WITH  VALID  INTEGER  AS  IRESLT 

C . RETURNS  .FALSE.  FOR  INVALID  INTEGER  WITH  IRESLT 

OCOMMON/ INTER/BLANK , BUFF ( 80 ) . CHAR . IN  >  NO  > 

1  NUM.OUT .PTR.SPLST ( 14) .TYP » YES 
INTEGER  BLANK. BUFF. CHAR. DEC. EXP 
INTEGER  OUT . PLUS .PTR . SPLST .TYP . YES 
EQUIVALENCE  ( DEC . SPLST ( 13 ) ) . ( EXP . SPLST ( 14 ) ) 
EQUIVALENCE  (MINUS. SPLST< 12) ) , (PLUS.SPLST(ll) ) 

C . —INITIALIZE  FOR  VALID  RETURN 

C — i^feT?!lE  NEXT  NON-BLANK  INPUT  CHARACTER 
10  IF(NEXT(0) )  10.70.20 

C . —INITIALIZE 

20  IRESLT=0 
ITEMP=0 
ISIGN=1 

C . -CHECK  FOR  OPTIONAL  SIGN 

IF(CHAR.EQ.PLUS)  GO  TO  30 
IF(CHAR,NE. MINUS)  GO  TO  40 
ISIGN=-1 

C - NEED  NEXT  INPUT,  MUST  BE  VALID  DIGIT 

30  IF(NEXT(0) )  70,70.40 
40  IF(TYP.NE.l)  GO  TO  60 

C . -ADD  DIGIT  TO  INTEGER  RESULT 

ITEMP=10*ITEMP+NUM 

C . -GET  NEXT  INPUT 

IF(NEXT(0) )  50,50,40 

C . -HAVE  RESULT,  STOPPED  ON  BLANK  OR  EOR 

50  IRESLT* ISIGNBI TEMP 
RETURN 

C . BAD  CHARACTER  ERROR,  ADVANCE  TO  BLANK  OR  EOR 

60  IF(NEXT(0) )  70,70,60 

C— . ERROR  ON  BLANK  OR  EOR 

70  INTEGR*. FALSE. 

0UT=6 

WRITE(OUT , 1000) 

RETURN 

1000  FORMAT  (29H  WHAT?  (INTEGER  SYNTAX  ERROR)) 

END 

LOGICAL  FUNCTION  NANE(TAG) 

C . READS  UP  TO  10  CHARACTER  NAME  IN  A1  FORMAT 

C . RETURNS  RESULT  IN  AlO  FORMAT,  BLANK  FILL  RIGHT 

C . RETURNS  .FALSE.  IF  NO  INPUT,  .TRUE.  OTHERWISE 

DIMENSION  MASK(IO) 

INTEGER  TAG 

OCOMMON/INTER/BLANK,BUFF(80), CHAR.IN.NO, 

1  NUM.OUT, PTR, SPLST(14), TYP, YES 
INTEGER  BLANK, BUFF, CHAR, DEC, EXP 
INTEGER  OUT, PLUS, PTR, SPLST, TYP, YES 
EQUIVALENCE  (DEC,SPLST( 13) ) , <EXP,SPLST< 14) ) 
EQUIVALENCE  ( M I NUS , SPLST  < 1 2 ) ) , ( PLUS , SPLST ( 11 ) ) 

DATA  MASK  (  1 ) /77000000000000000000B/ 

DATA  MASK  (  2)/00770000000000000000B/ 

DATA  MASK  (  3>/00007700000000000000B/ 

DATA  MASK  (  4)/00000077000000000000B/ 

DATA  MASK  (  5)/00000000770000000000B/ 

DATA  MASK  (  61/00000000007700000000B/ 
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DATA  HASK  (  7)/00000000000077000000B.' 

DATA  HASK  <  8>/00000000000000770000B/ 

DATA  MASK  (  ?)/00000000000000007700B/ 

DATA  MASK  < 10) /00000000000000000077B/ 

C . SKIP  TO  NON-BLANK 

10  IF(NEXT(0) )  10.70.20 

C . INITIALIZE  PACKING 

20  TAG=0B 
1=0 

ISHFT=0 

C . PACK  CHARACTER  I 

30  1=1+1 

ITEMP=SHIFT(CHAR* ISHFT) 

ITEHP=1TEMP.AND.MASK( I ) 

TAG=TAG,OR.ITEHP 

ISHFT=ISHFT-6 

C . TESTS  FOR  END 

IF(CHAR.EQ. BLANK)  GO  TO  50 
IF(I.GE.IO)  GO  TO  80 

C . GET  NEXT  CHAR  TO  BE  PACKED 

IF(NEXT (0) )  40*40*30 
40  CHAR=BLANK 
GO  TO  30 

C . LAST  CHAR  PACKED  WAS  BLANK 

C  CONTINUE  WITH  BLANK  FILL  TO  END 

50  IF(I.LT.IO)  GO  TO  30 
60  NAHE= .TRUE. 

RETURN 

C - RETURN  FOR  EMPTY  INPUT  RECORD 

70  TAG=BLANK 
NAME=. FALSE. 

RETURN 

. . AFTER  TENTH  CHARACTER  IS  PACKED. 

MOVE  TO  EOR  OR  FIRST  BLANK  CHARACTER 
IN  INPUT. 

80  IF(NEXT<0))  60*60.80 
RETURN 
END 

FUNCTION  NEXT(J) 

. —SCANS  INPUT  FOR  NEXT  CHARACTER. 

VALUE  =  -1  FOR  BLANK 
VALUE  =  0  FOR  EOR 

VALUE  =  +1  FOR  NON-BLANK  AND  ALSO  GIVES 
CHAR*  NUM.  TYP 

OCOHMON/ INTER/BLANK . BUFF ( 80 ) *  CHAR  *  IN  *  NO  * 

1  NUM*OUT*PTR*SPLST (14) *TYP* YES 
INTEGER  BLANK  *  BUFF  *  CHAR  *  DEC  *  EXP 
INTEGER  OUT . PLUS. PTR.SPLST* TYP* YES 
EQUIVALENCE  <DEC*SPLST( 13) > . (EXP*SPLST<14) ) 
EQUIVALENCE  (MINUS . SPLST ( 12 ) ) .  ( PLUS.SPLST (ID) 

C . INCREMENT  POINTER  AND  TEST  FOR  EOR 

PTR=PTR+1 

IF(PTR.GT.80)  GO  TO  20 

C . TEST  FOR  BLANK 

IF (BUFF (PTR ) «EQ. BLANK)  GO  TO  30 
C . HAVE  NON  BLANK  CHARACTER.  SET  NUMBER  AND 

£  ?oEEALLRofSiRiAL  CHARACTERS>  TrpE  6 

NEXT=1 

CHAR=BUFF(PTR) 

DO  10  1*1 *14 

IF ( CHAR. NE. SPLST ( I ) )  GO  TO  10 

NUN=I-1 

TYP=1 

IF(I.GT.IO)  TYP«l-9 
RETURN 
10  CONTINUE 
TYP*6 
RETURN 

C . EOR  RETURN 

20  NEXT-0 
GO  TO  40 


52 


C- . BLANK  RETURN 

30  NEXT=-1 
40  CHARsBLANK 
RETURN 
END 

LOGICAL  FUNCTION  YESNO(J) 

C . RETURNS  .TRUE.  FOR  YES,  .FALSE.  FOR  NO 

LOGICAL  ENTR 

0C0MM0N/INTER/BLANK,BUFF(80),CHAR,IN,NQ» 

1  NUM, OUT, PTR, SPLST  < 14)  »TYP, YES 
INTEGER  BLANK » BUFF » CHAR >  DEC » EXP 
INTEGER  OUT , PLUS ,  PTR , SPLST ,TYP, YES 
EQUIVALENCE  (DEC, SPLST ( 13 >  > , <EXP»SPLST< 14) ) 

EQUIVALENCE  (MINUS, SPLST(12> )  r  (PLUS,SPLST<11 ) ) 

C . —DISPLAY  PROMPT 

10  CONTINUE 
0UT=6 

C . READ  INPUT 

IF( .NOT .ENTR(O) )  GO  TO  50 

C . —SKIP  TO  FIRST  NON-BLANK,  OR  EOR 

20  IF(NEXT (0) )  20,50,30 

C - RETURN  IF  Y  OR  N 

30  IF(CHAR.NE.YES)  GO  TO  40 
YESNO=.TRUE. 

RETURN 

40  IF(CHAR.NE.NO)  GO  TO  50 
YESNO=. FALSE. 

RETURN 
50  CONTINUE 
0UT=6 

WRITE (OUT , 1010) 

WRITE(OUT , 1000) 

GO  TO  10 
C 

1000  FORMAT  (23H  ENTER  YES  OR  NO  (Y/N)J> 

1010  FORMAT  (AH  WHAT?) 

END 

BLOCK  DATA 

OCOMMON/INTER/BLANK , BUFF  <  80 ) » CHAR , IN , NO , 

1  NUM, OUT, PTR, SPLST (14) »TYP»YES 
INTEGER  BLANK, BUFF, CHAR, DEC, EXP 
INTEGER  OUT, PLUS, PTR. SPLST, TYP, YES 
EQUIVALENCE  ( DEC , SPLST ( 1 3 ) ) , ( EXP , SPL ST ( 1 4 ) ) 

EQUIVALENCE  (MINUS, SPLST ( 12) ) , (PLUS, SPLST < 11 ) ) 

DATA  BLANK/1H  /, IN/5/, N0/1HN/, OUT/6/, YES/1HY/ 

ODATA  (SPLST (I),I=1,14)/1H0»1H1,1H2»1H3,1H4, 

1  1H5»1H6»1H7» 1H8.1H9, 1H+, 1H-, 1H. ,1HE/ 

END 

SUBROUTINE  EXPLAIN(NMSG) 

DIMENSION  MSG(71),TXT(70) 

INTEGER  ONE, TERM, THR, TWO, TXT 
EQUIVALENCE  (MSG(2) ,TXT(1 ) ) 

ODATA  MSG( 1 ) / 10H ( 5X ,  */,0NE/lHl/,TERM/2H* )/,THR/lH3/, 

1  TW0/1H2/ 

CALL  READMSdl ,TXT,69,NMSG> 

NW-LENGTH(ll) 

IF(TXT ( 1 ) . EQ.ONE)  GO  TO  10 
IF(TXT(1) .EQ.TWO)  GO  TO  30 
NW=NW+1 
TXT  <NW)*TERM 

IF(TXT ( 1) .EQ.THR)  GO  TO  20 
WRITE(6,MSG) 

GO  TO  40 
10  WRITE(6,1000) 

GO  TO  40 
20  TXT ( 1 )*MSG(1 ) 

WRITE(A,TXT) 

30  WRITE (6,1010> 

40  WRITE(6,1020) 

RETURN 

10000F0RMAT  (5X,A0HREFER  TO  HACS  USER'S  REFERENCE  MANUAL  FOR  FIELD  DFSC 
1RIPTI0N.) 
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10100F0RHAT  (5X.58HREFER  TO  CHRIS  MANUAL  II  FOR  CHEMICAL  PROPERTY  DATA 
1ITEMS. ) 

1020  FORMAT  <5X> 

END 

LOGICAL  FUNCTION  QUEST(J) 

0C0MM0N/INTER/8LANK >  BUFF ( 80 ) * CHAR . IN  * NO » 

1  NUN .OUT  *PTR*SPLST(14) *TYP*  YES 
INTEGER  BLANK  * BUFF * CHAR  * DEC  *  EXP 
INTEGER  OUT *PLUS*F‘TR*SPLST *TYP* YES 
EQUIVALENCE  < DEC . SPLST < 1 3 ) > . <  EXP , SPLST <14 ) ) 

EQUIVALENCE  (MINUS* SPLST< 12 >>. (PLUS. SPLST < 11 ) ) 

* 

INTEGER  QUERY 
DATA  QUERY/10H? 


QUEST*. FALSE ♦ 

IF ( CHAR. EQ. QUERY)  QUEST*. TRUE. 

RETURN 

END 

SUBROUTINE  SNMSG(I) 

SUBROUTINE  PRINTS  SCENARIO  MESSAGES.  NOTE  THAT  THIS  FUNCTION 
COULD  LIKELY  BE  COMBINED  WITH  SUBROUTINE  EXPLAIN. 

DIMENSION  HSG(71) *TXT (70) 

INTEGER  TERM.TXT 
EQUIVALENCE  <MSG< 2) *TXT( 1 ) ) 

DATA  MSG(1)/10H(9X»  ,/*TERM/2H* >/ 

CALL  READMSd2.TXT *69*1) 

NW*LENGTH<12) 

NW-NW+1 

TXT(NH)=TERM 

WRITE(6*MSG) 

RETURN 

END 

SUBROUTINE  TNIT  (CODE* I  * J*K) 

SUBROUTINE  I, IT  INITIALIZES  THE  CODING  ROUTINES  TO  STORE  NEW 
CODES*  OR  TO  READ  PREVIOUSLY  STORED  CODES.  IN  THE  INTEGER 
ARRAY  CODE.  THE  ARRAY  CODE*  MUST  BE  DIMENSIONED  IN  THE 
CALLING  PROGRAM  TO  BE  OF  LENGTH  J  OR  GREATER.  THE  CHARACTER¬ 
ISTICS  OF  THE  STORED  NUMERIC  CODES  ARE  SPECIFIED  BY  THE 
REMAINING  ARGUMENTS  - 

I  =  MAXIMUM  NUMBER  OF  BITS  IN  EACH  WORD  OF  THE  ARRAY  CODE 

WHICH  CAN  BE  USED  FUR  STORAGE  OF  CODED  VALUES. 

J  *  MAXIMUM  NUMBER  OF  WORDS  IN  ARRAY  CODE  WHICH  ARE 

USED  FOR  STORAGE  OF  CODED  VALUES. 

K  *  DEFINES  THE  STORAGE  REQUIRED  FOR  A  SINGLE  CODED  VALUE 
TO  BE  FIXED  LENGTH  AT  K  BITS  PER  CODE.  THIS  DETER¬ 
MINES  THE  ALLOWED  INTEGER  MAGNITUDE  OF  EACH  CODED 
VALUE  TO  BE  GREATER  THAN  OR  EQUAL  TO  ZERO*  AND  LESS 
THAN  2**K. 

ON  RETURN*  THE  ERROR  FLAG  IERR  IN  COMMON  IS  ZERO  IF  NO  ERRORS 
WERE  ENCOUNTERED.  ERROR  CONDITIONS  WILL  CAUSE  IERR  TO  BE  SET 
TO  1. 2*7*8  OR  9  ON  RETURN*  AND  CONTROL  VARIABLES  IN  COMMON 
TO  BE  SET  FOR  SINGLE  BIT*  SINGLE  WORD  CODE  STORAGE. 

SUBROUTINE  INIT  CONTAINS  A  SINGLE  INTERNAL  PARAMETER*  MXWRD* 
WHICH  DEFINES  THE  MAXIMUM  ALLOWED  UNSIGNED  INTEGER  WORD 
LENGTH  IN  BITS  AND  IS  INSTALLATION  DEPENDENT.  FOR  A  NORMAL 
16-BIT  WORD  LENGTH*  MXWRD  SHOULD  BE  SET  TO  15.  FOR  USE  WITH 
DOUBLE  PRECISION  (TWO-WORD)  INTEGERS*  MXWRD  CAN  BE  SET  TO  31 
FOR  A  16-BIT  WORD  LENGTH  IF  INTEGER  SPECIFICATIONS  ARE  ALSO 
MODIFIED  IN  THESE  ROUTINES.  FOR  USE  ON  THE  CDC  CYBERNET  NET¬ 
WORK*  INTEGER  ARITHMETIC  IS  LIMITED  TO  PARTIAL  WORDS.  SO  MXWRD 
IS  SET  TO  47  OUT  OF  60  BITS  AVAILABLE  IN  THE  FULL  WORD. 

SUBROUTINE  INIT  MUST  BE  CALLED  ONCE  AND  ONLY  ONCE  FOR  EACH 
CODED  ARRAY  PRIOR  TO  ALL  CALLS  USING  THE  ROUTINES  SET*  RSET 
OR  ITST  WITH  THE  CODED  ARRAY.  NOTE  THAT  INIT  WILL  CLEAR  THE 
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CONTENTS  OF  THE  REFERENCED  CODED  ARRAY .  1N1T  JUST  BE  CALLED 
IMMEDIATELY  BEFORE  EACH  CALL  TO  THE  BULK  TRANSFER  ROUTINES 
PACK  AND  UNPK. 

COMMON  VARIABLES  USED  -  CDLN*CPW» IERR»L»MAXN,MAXV 
SUBROUTINES  REQUIRED  -  NONE 


COMMON/GCODE/IERR , CPU  , ITMP » SHFT  *  L  »  MAXN  *  CDLN » MAXV 
INTEGER  CPU. CDLN, SHFT 


INTEGER 

DATA 


CODE  < 1 ) 
MXWRD/47/ 


C 

C 

C 

C 

C 

C 

C 


. fill  ®Ti  OR  exceed°maximum%nsignedSntegerEuordAleSLh^ 

IF(I.LE.O)  GO  TO  20 
IF(I.GT.MXURD)  GO  TO  30 

. -TEST  NUMBER  OF  WORDS  TO  BE  USED  FOR  CODF  STORAGE.  CANNOT  BE 

I  cce  fuAM  i  UPPER  LiMIT  IS  NOT  TESTED  SINCE  THIS  IS 
CONTROLLED  BY  USER  DIMENSION  IN  CALLING  PROGRAM. 

IF(J.LE.O)  GO  TO  AO 

_ TEST  NUMBER  OF  BITS  TO  BE  USED  FOR  SINGLE  CODE.  CANNOT  BE 

LESS  THAN  1  OR  EXCEED  SPECIFIED  LENGTH  OF  CODE  WORD. 

IF(K.LE.O)  GO  TO  50 
IF(K.GT.I)  GO  TO  60 

__ mhpm&i  upturn .  COMPUTE  NUMBER  OF  CODES  TO  BE  STORED  PER 
WORD  (CPU),  INITIALIZE  ALL  CODE  WORDS  TO  ZERO,  AND  SET  NORMAL 
prritr  UPTURN .  COMPUTE  TOTAL  NUMBER  OF  CODES  WHICH  CAN  BE 
ItORED  (MAXN),  MOVE  CODE  LENGTH  K  TO  COMMON  VARIABLE  CDLN, 

AND  COMPUTE  MAXIMUM  ALLOWED  CODE  VALUE  (MAXV). 

IERR=0 
CPW*I/K 
DO  10  L=1 , J 
10  C0DE(L)=0 
MAXN=CPW*J 
CDLN=K 

MAXV=2MCDLN-1 

RETURN 

_ _ _ -PRRnR  RETURNS.  SET  VALUE  OF  ERROR  SWITCH  IN  COMMON  AND 

DEFAULT  TO  CODE  DEFINITION  USING  SINGLE  WORD  CONTAINING  CODES 
ONE  BIT  IN  LENGTH. 

20  IERR=1 
GO  TO  70 
30  IERR=2 
GO  TO  70 
40  IERR=7 
GO  TO  70 
50  IERR=8 
GO  TO  70 
60  1ERR=9 
70  CPW»MXURD 
CODE( 1 )=0 
MAXN*MXWRD 
CDLN=1 
MAXV=1 
RETURN 

LOGICAL  FUNCTION  ECHK(N) 

TSEH?S«oJTlHOIc8foRLYE8!DlS  "o|8o8  58d  9he’’ 

FUNCTION  RETURNS  A  VALUE  OF  .TRUE.  ALL  OTHER  VARIABLES  IN 
COMMON  ARE  UNCHANGED. 
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IF  THE  SPECIFIED  CODE  POSITION*  N *  IS  VALID*  THE  ERROR  CHECK 
FUNCTION  RETURNS  A  VALUE  OF  .FALSE.  AND  SETS  VARIABLES  IN 
COMMON  TO  ACCESS  THE  VALUE  OF  THE  NTH  CODE  PACKED  IN  AN  ARRAY. 
GIVEN  N*  THE  LOCATION  OF  THE  CODED  VALUE  IS  DETERMINED  BY  THE 
NUMBER  OF  CODED  VALUES  PER  STORAGE  UORD  (CPU)  AND  THE  LENGTH 
OF  EACH  CODE  (CDLN)  •  BOTH  CPU  AND  CDLN  ARE  DETERMINED  ON 
INITIALIZATION  IN  SUBROUTINE  INIT.  FOR  ACCESSING  THE  REQUESTED 
CODE  THE  FUNCTION  RETURNS  L  AND  SHFT.  THE  VALUE  OF  L  IS  THE 
SUBSCRIPT  INDEX  TO  THE  UORD  OF  THE  PACKED  ARRAY  CONTAINING 
THE  POSITION  FOR  THE  CODED  VALUE.  SHFT  IS  AN  INTEGER  MULTI¬ 
PLIER  OR  DIVISOR  UHICH  WILL  MOVE  A  CODED  VALUE  OF  LENGTH  CDLN 
TO  OR  FROM  ITS  POSITION  IN  UORD  L  FROM  OR  TO  THE  LOU  ORDER 
NUMERIC  POSITION. 

COMMON  VARIABLES  USED  -  CDLN*CPU*IERR*L*MAXN*SHFT*ITMP 
SUBROUTINES  REQUIRED  -  NONE 


COMMON/GCODE/IERR • CPU* ITMP *  SHFT  *  L  *  MAXN. CDLN*  MAXV 
INTEGER  CPV*CDLN*SHFT 
EQUIVALENCE  (I, IPOS. ITMP) 


- TEST  REQUESTED  CODE  POSITION.  MUST  LIE  UITHIN  DEFINED 

BOUNDARY  OF  CODE  UORD  STRUCTURE. 

IF(N.LE.O)  GO  TO  10 
IF(N.GT.MAXN)  GO  TO  20 

—NORMAL  RETURN.  SET  ERROR  CODE  AND  FUNCTION  VALUE. 

IERR=C 

ECHK=. FALSE. 

- COMPUTE  UORD  ADDRESS  <L>  UITHIN  CODE  LIST  ARRAY.  AND  POSITION 

ADDRESS  (IPOS)  UITHIN  UORD  L  FOR  CODE  LOCATION  N. 

I=N-1 

L=I/CPU 

IPOS=I-L*CPU 

L=L+1 


- COMPUTE  SHIFT  FACTOR  TO  ACCESS  CODE  N  IN  POSITION  IPOS  OF 

UORD  L. 

I*CDLNtIPQS 

SHFT«2WI 

RETURN 


. ERROR  RETURNS. 

10  IERR=3 
GO  TO  30 
20  IERRM 
30  ECHK*.TRUE. 

RETURN 

END 

FUNCTION  ITST(CODE.N) 

FUNCTION  ITST  RETURNS  THE  INTEGER  VALUE  OF  CODE  N  STORED  IN 
A  PACKED  ARRAY  CODE.  IF  N  IS  NOT  WITHIN  THE  RANGE  OF  THE 
PACKED  CODES*  A  VALUE  OF  ZERO  IS  RETURNED  FOR  ITST  AND  IERR 
IS  SET  TO  3  OR  A.  IF  N  IS  VALID*  THE  VALUE  OF  ITST  IS  OBTAINED 
FROM  THE  PACKED  CODE  IN  POSITION  N  IN  THE  RANGE  0  TO  MAXV*  AND 
IERR  IS  RETURNED  AS  ZERO.  DEFINITION  OF  THE  PACKED  CODE 
STRUCTURE  IS  OBTAINED  FROM  THE  MOST  RECENT  CALL  TO  SUB¬ 
ROUTINE  INIT. 

COMMON  VARIABLES  USED  -  ITMP. L.MAXV. SHFT 
SUBROUTINES  REQUIRED  -  ECHK 


COMMON/GCODE/IERR*  CPU* ITMP*  SHFT  *  L .MAXN.CDLN*  MAXV 
INTEGER  CPU.SHFT  *CDLN 


* 
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INTEGER 

LOGICAL 


CODE(l) 

ECHK 


- INITIALIZE  FUNCTION  VALUE  AND  RETURN  IF  N  IS  INVALID. 

ITST=0 

IF(ECHK(N) )  RETURN 

- MOVE  CODED  VALUE  IN  UORD  L  TO  LOU  ORDER  POSITION  OF  ITNP. 

I TMP=C0DE ( L  > /SHFT 

-—OBTAIN  CODED  VALUE  BY  REHOVING  ANY  BITS  REMAINING  IN  HIGHER 
ORDER  POSITIONS. 

ITST*ITNP.AND.NAXV 

RETURN 

END 

SUBROUTINE  SUHRY 

COMMON  VARIABLES  USED  -  ICD ?LP» MODEL tPTLST. SNCOD 
SUBROUTINES  REQUIRED  -  INIT » ITST » PAGER »SNMSGfSPRNT»YESNO 
DATE  -  23  JANUARY  1981 


OCOHHON/CNTRL/EOFFt ICDi 1DFLT  »LBL(4) »LSTCN(3»3) rMQDEL( 15) »N0P» 
1  STCONf SVCON 

INTEGER  EOFFtSTCON.SVCON 

REAL  LBL 

COMMON/HEAD/DTE *  LNCT  >  LNPG  »LP . NPG  >  T I TLE  < 1 0  > 

COMNON/NAME/PTLST ( 30 ) » SOURCE ( 7 ) 

INTEGER  PTLST 

COMMON/PXFER/BUFF ( 15 ) , K1 * SNCOD 
INTEGER  BUFF » SNCOD 


DIMENSION  ITXT(5) » IVAL(5) *SCLST(28) 

INTEGER  SCLST 
LOGICAL  YESNO 

ODATA  (SCLST ( I ) . 1=1 .28) /3HA  B.3HA  CiSHA  B  C.5HA  D  E.7HA  D  F  G* 

1  9HA  D  E  F  G*3HA  H.5HA  I  J.7HA  H  I  J.5HA  K  Lr7HA  K  M  N» 

2  9HA  K  L  M  N.3HA  0.3HA  P.5HA  P  Q.7HA  P  R  S.9HA  P  Q  R  S» 

3  3HA  T.5HA  T  U.5HA  V  W.9HA  T  U  V  W.3HA  X.5HA  X  Y.1HZ.2HII. 

4  2HRR.4HRR  C.2HSS/ 


CALL  PAGER<2) 
URITE(LP.IOOO) 

IF( .NOT. YESNO(O) )  RETURN 
DO  10  1=1*5 
IVAL(I )=0 
10  ITXT(I)=0 
CALL  PAGER(2) 
HRITE(LP.IOIO) 

CALL  PAGER<2) 
URITE(LP»1020) 

IF < .NOT. YESNO(O) )  GO  TO  20 
IVAL ( 1  )*1 
CALL  PAGER (2) 
URITE(LP»1030) 

IF(YESNQ(0) )  ITXT(1)-1 
20  CALL  PAGER (2) 

URITE(LP* 1040) 

IF ( .NOT , YESNO(O) )  GO  TO  30 
IVAL(2)*1 
CALL  PAGER<2) 
HRITE(LP»1030) 
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IF<YESN0<0))  ITXT (2)=1 
30  CALL  PAGER<2) 

WRITEdP,1050) 

IF ( *N0T* YESNO(O) )  GO  TO  40 

IVAL<3)=1 

CALL  PAGER (2) 

WRITEdP,1030) 

IF( YESNO(O) )  ITXT(3)=1 
40  CALL  PAGERC2) 

WRITE (LP» 1060) 

IF ( »NOT * YESNO(O) )  GO  TO  50 

IVAL(4)=1 

CALL  PAGER (2) 

WRITEdP,1030) 

IF< YESNO(O) )  ITXT ( 4)=1 
50  CALL  PAGER (2) 

WR1TE(LP . 1080) 

IF( .NOT. YESNO(O) )  GO  TO  70 

IVAL(5)=1 

CALL  PAGER(2) 

WRITEdP,  1030) 

IF(YESN0<0)>  ITXT(5)=1 

I - START  REPORT 

70  CALL  PAGER(O) 

CALL  PAGER(7) 

WRITE<LP»1090)  ICD 

: - SCENARIO  SUMMARY 

IFdVAL(l)  .EQ.O)  GO  TO  90 
CALL  PAGER (4) 

WRITEdP, 1100) 

CALL  INIT (ITKPf 28> 1 , 1 ) 

00  80  1=1 ,28 
ITMP*ITST(SNCOD, I ) 

IFdTMP.EQ.O)  GO  TO  80 
CALL  PAGER (3) 

WRITEdP, 1110)  SCLST(I) 

IF ( ITXT d ) <EQ< 1 )  CALL  SNMSG(I) 

80  CONTINUE 

: - MODEL  SUMMARY 

90  IF ( IVAL(2) .EQ.O)  GO  TO  110 
CALL  PAGER (4) 

WRITEdP,  1120) 

DO  100  1=1,15 
J*MODEL(I> 

IF( J.GE.30)  GO  TO  100 
IF(J.LE.O)  GO  TO  100 
CALL  PAGER (3) 

WRITEdP*  1130)  PTLST(J) 

IF(ITXT(2).EQ,1)  CALL  MODEXP(J) 

100  CONTINUE 

: - USER  INPUT  SUMMARY 

110  IF(IWAL(3) .EQ.O)  GO  TO  120 
CALL  PAGERC4) 

WRITEdP, 1150) 

CALL  SPRNT( 5,5, ITXT ( 3) ) 

l - COMPUTED  VALUE  SUMMARY 

120  IF ( I VAL (4> *E0»0)  GO  TO  130 
CALL  PAGER < 4) 

WRITEdP, 1160) 

CALL  SPRNT(2»6*ITXT(4) ) 

: - CHEMICAL  PROPERTY  VALUES 

130  IF<IVAL<5).EQ.0>  GO  TO  150 
CALL  PAGER<4) 

WRITE(LPfllBO) 

CALj^SPRNT(2,3,ITXT<5)> 

'’lSo'cALL  PAGERC5) 

WRITE<LP, 1190) 

RETURN 

m 

'1000  FORMAT  </49H  BO  YOU  WANT  TO  PRINT  A  SUMMARY  OF  THESE  RESULTS?) 

1010  FORMAT  (/38H  WHICH  OF  THE  FOLLOWING  DO  YOU  WANT?) 


1 
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onnn  nan  000000000000 


1020  FORMAT  </18H 
1030  FORMAT  (/28H 
1040  FORMAT  I/15H 
1050  FORMAT  (/21H 
1040  FORMAT  U25H 
1080  FORMAT  </28H 
10900F0RMAT 


SCENARIO  CODES’) 

WITH  TEXT  DESCRIPTIONS?) 

MODEL  CODES?) 

USER  FIELD  VALUES?) 

COMPUTED  FIELD  VALUES?) 

CHEMICAL  PROPERTY  FIELDS?) 

<//lX»49<lH*)/47H  SUMMARY  OF  HAZARD  ASSESSMENT  RUN  FOR  CHEM 
II CAL  .A3/1X.49UH*)//) 

11000F0RMAT  (/5X.44HAPPR0PRIATE  HAZARD  ASSESSMENT  SCENARIOS  AREJ/5X. 

1  44  < 1H—  > / > 

11200FORMAT  (/5X.51HHAZARD  ASSESSMENT  MODELS  UTILIZED  IN  THIS  RUN  WERE 5 
1  /5X.51UH-)/) 

1110  FORMAT  (/5X.A10/) 

1130  FORMAT  </5X»A4/) 

1150  FORMAT  (/5X.34HUSER  INPUT  DATA  FOR  THIS  RUN  UERE5/5X.34UH-)/) 

1140  FORMAT  I/5X.31HC0NPUTED  RESULTS  OBTAINED  WEREJ/5X.31UH-)/) 

1180  FORMAT  (/5X.38HCHEMICAL  PROPERTY  DATA  AVAILABLE  WERE5/5X»38(1H-)/) 
1190  FORMAT  < 1X,24(1H*)/25H  END  OF  REQUESTED  SUMMARY/1X.24UH*)/) 

END 

SUBROUTINE  SPRNT (ILi IH.IT ) 

CALL  SPRNT(2*3»IT)  GIVES  PROPERTY  REPORT 
CALL  SPRNT(2.4,IT)  GIVES  COMPUTED  VALUE  REPORT 
CALL  SPRNT <5. 5. IT )  GIVES  USER  VALUE  REPORT 

COMMON  VARIABLES  USED  -  FVAL.IVAL. LIST. LP.NF.NI.SQURC, UNIT 

SUBROUTINES  REQUIRED  -  EXPLAIN.FCNV. PAGER 

DATE  -  23  JANUARY  1981 

OCOMMON/BASE/SAVE<2489) »UPTH(15) .NSG(IO) .HNF.MNI »NF.NI.LIST(275»6> » 
1  FVAL  <  225  *  3 ) » I VAL ( 50 1 3 ) 

INTEGER  UPTH 

REAL  MSG 

DIMENSION  STATE<2489> 

EQUIVALENCE  (STATE(l).NSG(l)) 

COMMON/CNVDT /CONV (3.47). MSYS  . MT YP » UNIT ( 4 . 47 ) 

COMMON/HEAD/DTE . LNCT »LNPG*LP»NPG.TITLE( 10) 

C0MM0N/NAME/PTLST<30) »S0URC<7) 

INTEGER  PTLST 

ICNT=0 
NFLD=NI+NF 
DO  30  ILN=1 .NFLD 
IFLD*LIST  < ILN.  1 ) 

ITYP=(LISTULN»2)-IS)/10 

IS=LIST(ILN»2)-10*ITYP-IS 


C 

C- 


CONDITIONS  FOR  FIELD  OUTPUT  SELECTION  DEPENDING  ON  TYPE  OF 
REPORT  SELECTED.  STATEMENT  30  SKIPS  FIELD.  STATEMENT  5 
SELECTS  FIELD  FOR  REPORT. 

IFUS.LT.IL)  GO  TO  30 
IF(IS.GT.IH)  GO  TO  30 
IF( 1H.EQ.5)  GO  TO  5 
IFUH.NE.3)  GO  TO  1 
IFUFLD.EQ.2032)  GO  TO  5 
IFUFLD.EQ.2033)  GO  TO  5 
IFUFLD.GT .1999)  GO  TO  30 
IF(|FLJ.LT.1002)  GO  TO  30 

IF(IS.EQ.5>  GO  TO  30 
IF(IFLD,E0.2032>  GO  TO  30 
IFUFLD.EQ.2033)  GO  TO  30 
IFUFLD.IE.1999)  GO  TO  30 


•FIELD  SELECTED  FOR  OUTPUT 
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l **********  . 


V 


5  ICNT=ICNT+1 
IX=LIST(ILN*6> 

IF(IVAR.EQ.O)  60  TO  10 

. DISPLAY  REAL  FIELD  VALUE 

VAL=FVAL(IX*1 ) 

CALL  FCNV(IFLD*ILN*VAL*ITYP*IS> 

GO  TO  20 

. DISPLAY  INTEGER  VALUE 

10  CALL  PAGER(2) 

0WRITE(LP*1010)  1FLD*(LIST<ILN*I>  *1=3*5)  *IVAL (IX? ■> ) 
1  UNIT(1*ITYP),S0URC(IS+1> 

. TEST  FOR  TEXT  AUDIT 

20  IF(IT.EQ.l)  CALL  EXPLAIN(ILN) 

30  CONTINUE 

- ADD  MESSAGE  IF  NO  OUTPUT  IS  PRINTED 

IF ( ICNT.GT.O)  RETURN 
CALL  PAGER(l) 

WRITE (LP» 1020) 

RETURN 


1010  FORMAT  (5X*I4»1X*3A4.5H 


* I10*5X*A8*8H*  IS  A  *A8*7H  VALUE/) 


1020  FORMAT  (10X*13HN0T  PERTINENT) 

END 

SUBROUTINE  MODEXP(NMSG) 

DIMENSION  MSG(192) f TXT (191 > 

INTEGER  TERM.TXT 
EQUIVALENCE  (MSG(2) * TXT( 1 ) ) 

DATA  LP/4/*MSG( 1 )/10N(9X*  *//TERM/3H’/)/ 

CALL  READMS( 13*TXT » 190»NMS6) 

NW=1+LENGTH( 13) 

TXT(NW)=TERM 

URITE(LPtHSG) 

RETURN 

END 

OVERLAY (1*0) 

PROGRAM  INPUT 

PROGRAM  INPUT  PERFORMS  THE  FUNCTIONS  OF  INTERPRETING  ALL  USER 
DATA*  ACCESSING/LOADING/UPDATING  THE  DEFAULT  FILE  AND  ACCESSING 
THE  HACS  PHYSICAL  PROPERTY  FILE.  THE  BASIC  STRUCTURE  OF  ALL 
HACS  DATA  DECKS  IS  AS  FOLLOWS  - 

1.  RUN  CONTROL  OPTION  CARD 

2.  RUN  TITLE  CARD 

3.  ASSESSMENT  PATH  CARD 

4.  CHEMICAL  RECOGNITION  CODE  CARD 

5.  ONE  OR  MORE  FIELD  DATA  CARDS 

6.  DATA  DECK  SEPARATOR  CARD  (9999)  OR  END  OF  FILE  CARD 
WHERE  THE  SPECIFIC  PROCESSING  OF  EACH  TYPE  OF  DATA  DECK  IS 
DETERMINED  BY  THE  RUN  CONTROL  OPTION  WHICH  HAS  BEEN  SELECTED. 

THE  CONTENT  AND  FORMAT  OF  FIELD  DATA  CARDS  PROCESSED  BY  HACS 
ARE  DEFINED  BELOW  - 

IFLD  *  INTEGER  FIELD  NUMBER  (UP  TO  FOUR  DIGITS  IN  C.C.  1  TO 
4).  VALUE  MUST  BE  POSITIVE*  AND  A  VALUE  OF  9999 
TERMINATES  FIELD  DATA  INPUT. 

FVL  =  FIELD  VALUE*  ENTERED  IN  C.C.  5  TO  19  IN  FIXED  POINT 
FORMAT.  ALL  INTEGERS  MUST  BE  RIGHT  JUSTIFIED. 

REAL  FIELD  VALUES  WITHOUT  EXPONENT  MAY  BE  LOCATED 
ANYWHERE  IN  FIELD  IF  DECIMAL  POINT  IS  GIVEN. 
EXPONENTIAL  NOTATION  MAY  BE  USED*  BUT  EXPONENT 
FIELD  MUST  BE  RIGHT  JUSTIFIED. 

TAG  =  UNIT  LABEL*  UP  TO  EIGHT  CHARACTERS  LEFT  JUSTIFIED  IN 

C.C.  20  TO  27.  APPLIES  TO  FIELD  VALUE  FVL*  AND  ALSO 
TO  MIN  AND  MAX  VALUES  IF  GIVEN.  IF  THE  UNIT  FIELD 
IS  BLANK*  DIMENSIONS  OF  INPUT  VALUES  ARE  ASSUMED  TO 
BE  CONSISTENT  WITH  PRE-DEFINED  UNITS  USED  IN 
HACS  INTERNAL  COMPUTATIONS. 

IR  *  FLAG  FOR  INTEGER  (0)  OR  REAL  (1)  FIELD  VALUES  IN  C.C. 

28.  INPUT  VALUES  ARE  ALLOWED  ONLY  DURING  CREATION 
OF  DEFAULT  FILE*  AND  IN  ORDER  TO  CHANGE  THIS  VALUE 
THE  ENTIRE  DEFAULT  FILE  MUST  BE  RE-LOADED.  NOTE 
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THAT  CALLS  TO  SAVE  AND  RECALL  ROUTINES  ARE  CODED 
DEPENDING  ON  IR »  SO  CHANGES  IN  THIS  VALUE  HAY  ALSO 
REQUIRE  CODE  CHANGES.  (REFER  TO  ERROR  CONDITIONS 
IN  SAVE/RECALL.) 

MM  =  INDICATOR  IN  C.C.  29  USED  TO  CONTROL  INPUT  OF  RANGE 
VALUES  AS  FOLLOWS  - 

0  *  NEITHER  VALUE  ENTERED 

1  =  ONLY  HINIMUH  VALUE  ENTERED  IN  C.C.  30  TO  44 

2  *  ONLY  MAXIMUM  VALUE  ENTERED  IN  C.C.  45  TO  59 

3  =  BOTH  MINIMUM  AND  MAXIMUM  VALUES  ENTERED 
WHEN  LOADING  THE  DEFAULT  FILE*  BOTH  MIN  AND  MAX 
VALUES  MUST  BE  GIVEN  AND  MM  MUST  BE  3. 

FMN  =  MINIMUM  FIELD  VALUE,  ENTERED  IN  C.C.  30  TO  44  IN 
FIXED  POINT  FORMAT  (RIGHT  JUSTIFIED).  VALUE  IS 
READ  IF  MM  IS  1  OR  3,  AND  CONVERTED  DEPENDING  ON 
INPUT  OF  UNIT  LABEL,  TAG.  SEE  ALSO  FVL  ABOVE. 

FMX  =  MAXIMUM  FIELD  VALUE,  ENTERED  IN  C.C.  45  TO  59  IN 
FIXED  POINT  FORMAT  (RIGHT  JUSTIFIED).  VALUE  IS 
READ  IF  MM  IS  2  OR  3,  AND  CONVERTED  DEPENDING  ON 
INPUT  OF  UNIT  LABEL,  TAG.  SEE  ALSO  FVL  ABOVE. 

ITP  =  INTEGER  SPECIFICATION  IN  C.C.  60-61,  RIGHT  JUSTIFIED, 
FOR  TYPE  OF  PHYSICAL  QUANTITY  (USED  TO  CONTROL  UNIT 
CONVERSION  AND  DISPLAY) 

IN  *  UP  TO  12  CHARACTER  FIELD  NAME,  LEFT  JUSTIFIED  IN  C.C. 
62  TO  73,  USED  TO  IDENTIFY  OUTPUT 
=  C.C.  74  TO  80  ARE  NOT  USED  FOR  INPUT  DATA  FIELDS 
EXCEPT  THAT  THE  CORRESPONDENCE  TO  PROPERTY  FILE 
FIELDS  HAS  BEEN  GIVEN  ON  DEFAULT  CARDS.  ANY  OTHER 
SEQUENCE  OR  IDENTIFICATION  INFORMATION  MAY  BE 
ENTERED  IF  DESIRED. 

THE  CONTENT  OF  THE  HACS  DEFAULT  FILE  IS  DEFINED  BY  THE 
SEQUENCE  IN  WHICH  DATA  CARDS  ARE  READ  DURING  THE  CREATE 
DEFAULT  FILE  OPTION.  CONSECUTIVE  ARRAY  POSITIONS  ARE  LOADED 
SEQUENTIALLY.  THE  ONLY  FIXED  DEFINITION  IS  THAT  LIST<1,1) 

IS  RESERVED  FOR  FIELD  1001,  CHEMICAL  RECOGNITION  CODE. 

CNT  *  COUNT  OF  FIELD  DATA  CARDS  READ  BY  SUBROUTINE  BASIC, 
USED  TO  ABORT  HACS  RUN  IF  DEFAULT  FILE  IS  TO  BE 
CREATED  OR  UPDATED  BUT  NO  CARDS  ARE  READ 
CR  =  INTEGER  FORTRAN  UNIT  NUMBER  FOR  CARD  READER 

FBLNK  =  DATA  WORD  SET  TO  ALL  BLANKS  USED  TO  INITIALIZE  LABELS 

I  *  DUMMY  SUBSCRIPT,  ARRAY  INDEX 

IARG  =  ARRAY  FOP  READING  USER  OPTIONS  FOR  HACS  STATE  FILE 

DISPLAYS 

IBLNK  =  DATA  WORD  SET  TO  ALL  BLANKS  FOR  TESTING  CHEMICAL 
RECOGNITION  CODE 

IERR  *  ERROR  INDICATOR  (=1),  OTHERWISE  0.  USED  TO  ABORT 
RUN  IF  ERROR  OCCURS  UHILE  READING  DEFAULT  DATA 
IFLD  =  FIELD  NUMBER  ON  RECOGNITION  CODE  CARD,  MUST  BE  1001 

IN  *  ARRAY  USED  FOR  READING  LABELS  ON  USER  DATA  CARDS 

ISW  *  ERROR  STATUS  INDICATOR  RETURNED  BY  PATH  CHECK  ROUTINE 

IX  *  TEMPORARY  VARIABLE  USED  TO  UPDATE  SOURCE  CODE  OF 

RECOGNITION  CODE  IN  STATE  FILE 
J  =  DUMMY  SUBSCRIPT  OR  ARRAY  INDEX 

K  *  SUBSCRIPT  USED  IN  STORING  FILE  DISPLAY  OPTIONS 

L  =  SUM  OF  FILE  DISPLAY  OPTION  VALUES  ENTERED  BY  USER, 

USED  TO  GENERATE  AUDIT  ONLY  IF  ONE  OR  MORE  OPTIONS 
WERE  SELECTED 

OPLST  =  ARRAY  CONTAINING  THE  FIRST  FOUR  CHARACTERS  OF  EACH 
VALID  RUN  CONTROL  OPTION 

COMMON  VARIABLES  USED  -  EOF, ICD,IDFLT,IPRAC,IVAL,LBL, LIST, 

LP , LSTCN , MNF , MNI , MODEL , MSG , MSYS  »NF»NI » 
NOP , PTL  ST , S AVE , ST ATE , STCON , SVCON , TITLE, 
UPTH 


SUBROUTINES  REQUIRED 


ACCESS , BASIC , IFEOF , LSTFL , PAGER , PROP , 
PTHCK,RNTIO, TRACE 


AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/309A  ACORN  PARK, 


61 


CAMBRIDGE)  MASS. t  02140 
TEL.  617-864-5770  EXT.  2813 
-  12  FEBRUARY  1976 


0C0MM0N/BASE/SAVE(2489) *UPTH( 15) »MSG<10) , MNF.MNI > 

1  NF»NI*LIST(275»6) »FVAL(225»3) » IVAL(50»3) 

INTEGER  UPTH 

REAL  MSG 

DIMENSION  STATE<2489> 

EQUIVALENCE  (STATE* 1 > »MSG< 1 > ) 

OCOMMON/CNTRL/EOFF  fICD»IDFLT»LBL(4) »LSTCN(3»3) » MODEL ( 15) »NOP» 

1  STCON  f SVCON 

INTEGER  EOFF.STCON.SVCON 

REAL  LBL 

C0MMQN/CNVDT/C0NV(3f 47) »MSYS>HTYP*UNIT(4»47) 

COMMON/HEAD/DTE »LNCT  >LNPG»LP»NPG» TITLE (10) 

COMMON/IOCNT/ICVSLt IPRAC» IPRRPiNOFF*NPRRF“ 

COMMON/NAME/PTLST  <  30 ) » SOURC  <  7 ) 

INTEGER  PTLST 

COMMON/PXFER/BUFF ( 15) . K1 »SNCOD 

INTEGER  BUFFiSNCOD 

DIMENSION  IARG(6) » IN<4) t OPLST (5) 

INTEGER  TAGX 
LOGICAL  ENTR.NAHE 
LOGICAL  QUEST 
LOGICAL  YESNO 
LOGICAL  INTEGR 
INTEGER  CNT iCR.OPLST 
INTEGER  SCLST (28) 

INTEGER  EXIT 
DATA  EXI7/4HEXIT/ 

ODATA  (SCLST < I ) *  I  — 1 .28) /3HA  B»3HA  C.5HA  B  C.5HA  D  E.7HA  D  F  G. 

1  9HA  D  E  F  Gf 3HA  Hr5HA  I  J.7HA  H  I  J.5HA  K  L.7HA  UN. 

2  9HA  K  L  M  N.3HA  0.3HA  P.5HA  P  Q » 7HA  P  R  St 9HA  P  &  R  St 

3  3HA  Tt5HA  T  Ut5HA  V  Ut9HA  T  U  V  W.3HA  Xt5HA  X  Yt1HZt?HIIt 

4  2HRR t 4HRR  Ct2HSS/ 

DATA  CR/60/tFBLNK/10H  /tIBLNK/4H  / 

ODATA  (OPLST < I ) t 1  =  1 »5) /8HRUN  t8HRERUN  t8HC0NTINUEt 
1  8HEND  t8H  / 


. INITIALIZE 

CALL  TRACE(OtItO) 

* 

I - RETURN  HERE  TO  READ  NEXT  CONTROL  CARD.  TERMINATE  ON  END  OF  FILE 

10  N0P=0 

URITE(LPt2000) 

20000FORMAT ( 32H  ENTER  RUN  REQUEST t  OPTIONS  ARE  t 
1  24H(RUN/RERUN/C0NTINUE/END) ) 

IF( .NOT .ENTR(O) )  GO  TO  10 
IF ( .NOT .NAME (TAGX) )  GO  TO  10 
IF(TAGX.EQ.0PLST(4>)  GO  TO  430 


. SEARCH  LIST  OF  FIRST  FOUR  CHARACTERS  OF  CONTROL  OPTIONS 

11  DO  20  N0P=1 t  3 

IF (TAGX . EQ. OPLST (NOP) )  GO  TO  21 

20  CONTINUE 

I . TERMINATE  ON  INVALID  CONTROL  CARD 

WRITE(LP»2010) 

2010  FORMAT ( 26H  WHAT?  (RUN  REQUEST  ERROR)) 

GO  TO  10 

21  DO  22  1=1)6 

22  IARG( I )=0 
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noon  non  nnonn 


GO  TO  60 
C 

30  CALL  PAGER (3) 
WRITE<LP,1020) 
STOP 


C 

C . READ  TITLE  CARD  AND  STORE  FOR  OUTPUT  PAGE  HEADING 

40  CONTINUE 
GO  TO  60 

C . TERMINATE  ON  UNEXPECTED  END  OF  FILE 

50  CALL  PAGER (3) 

HRITE(LP»1030) 

GO  TO  30 
C 

C - BRANCH  ON  OPERATION  CONTROL  FLAG  TO  INITIALIZE  STATE  FILE 


60  GO  TO(70f90fl20»130»70)»NOP 
C 

70  IF(STC0N«EQ*2)  GO  TO  150 
80  IF<SVC0N.£Q.2>  GO  TO  10^ 

CALL  ACCESS ( STATE » I DFLT »0f STCON) 

GO  TO  150 
C 

90  IF(SVCON.GT.l)  GO  TO  100 

CALL  ACCESS ( SAVE » IDFLT »0 r SVCON ) 

100  DO  110  1=1.2489 
110  STATE(I)=SAVE(I) 

STCON=SVCON 
GO  TO  150 
C 

120  IF(STCON.LE.l)  GO  TO  80 
GO  TO  150 
C 

130  STC0N=1 
SVC0N=1 
NF=0 
NI=0 

DO  140  I=l»10 
140  MSG<I)=FBLNK 
C 

C- . START  NEW  PAGE  AND  WRITE  FILE  INITIALIZATION  MESSAGE 

150  CALL  PAGER (0) 

CALL  PAGER<5) 

WRITE(LP,1040)  LBL(STCON) »MSG 

. DECODE  FILE  LIST  OPTIONS  AND  STORE  IN  LSTCN  FOR  USE  IN 

SUBROUTINE  LSTFL. 

IERR=0 
L=0 
K=0 

DO  190  I=l»3 
DO  160  J=2.3 
K=K+1 

L=L+IARG(K) 

160  LSTCN ( I» J)=IARG<K) 

. OVERRIDE  ANY  USER  INPUT  ERRORS f  BUT  SET  ERROR  FLAG  TO  PRODUCE 

AUDIT  MESSAGE. 

IF(LSTCN< I »2) .LE.MSYS)  GO  TO  180 
170  IERR=1 

LSTCN(I» 1)=0 
GO  TO  190 

180  IF<LSTCN(I»2).LT.O)  GO  TO  170 
IF<LSTCN< 1*3) .LT.O)  GO  TO  170 
IF(LSTCN(I»3).GT.l)  GO  TO  170 
LSTCN ( I t 1 )=LSTCN( I »2)+LSTCN(I r3) 

IF(LSTCN< I » 1 ) .GT .0 )  LSTCN<I.1)*1 
190  CONTINUE 

. DISPLAY  STATE  FILE  AFTER  INITIALIZATION  IF  OPTION  SELECTFDf 

THEN  PUT  USER  TITLE  IN  STATE  FILE  AND  WRITE  HEADER  FOR  LISTING 
OF  USER  INPUT  DATA 
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c 

c 


c 


c 


c 

c 

c 


c 

c 


CALL  LSTFL(l) 

DO  200  1=1.10 
200  HSG< I )=TITLE< I ) 

GO  TO  500 

. READ  PATH  CODE  INPUT  CARD.  TERMINATE  IF  INSTEAD  GFT  END  OF 

FILE,  OTHERWISE  AUDIT  INPUT  THEN  VALIDATE.  RUN  IS  TERMINATED 
UNLESS  USER  INPUT  PATH  CODES.  FOR  ALL  OPERATIONS.  SATISFY  ALL 
VALIDATION  TESTS  IN  SUBROUTINE  PATH  CHECK. 

212  WRITE(LP»2020> 

2020  FORMAT (52H  ENTER  ASSESSMENT  MODEL  LETTER  CODES  (A-Z/II/RR/SS) 1 ) 

IF < . NOT.ENTR(O) >  GO  TO  410 
IF( .NOT .QUEST (0) )  GO  TO  620 

. USER  TYPED  ?.  PRODUCE  SCENARIO  TABLE 

WITH  HEADER  AND  FOOTNOTES 
CALL  SNNSG(29> 

WRITE(LP»6005)  ICD 
CALL  INIT(ITMP.28.1.1) 

DO  600  1=1.28 
ITMP=ITST (SNCOD.I) 

IF(ITMP.EQ.O)  GO  TO  600 
WRITE(LP.6010)  SCLST(I) 

CALL  SNMSG(I) 

600  CONTINUE 

WRITE(LP,6020) 

CALL  SNMSG<30) 

CALL  SNMSG<31) 

WRITE(LP.6020) 

ISW=1 
GO  TO  700 

60050F0RMAT  (/9X.35HSCENARI0S  APPROPRIATE  FOR  CHEMICAL  .A3.22H  ARE  DESC 
1RIBED  BELOW  -//) 

6010  FORMAT  (/5X.A10/) 

6020  FORMAT  (IX) 

- USER  TYPED  <CR),  DISPLAY  CURRENT  MODELS 

610  WRITE(LP. 6030)  (BUFF(I) . 1=1, Kl) 

ISW=1 
GO  TO  700 

6030  FORMAT  (9X.43HAPPR0PRIATE  HAZARD  ASSESSMENT  MODELS  ARE  :  ,15A3) 

- USER  TYPED  MODEL  INPUT 

620  CONTINUE 

DO  213  1=1,15 
UPTH( I )=IBLNK 

IF ( .NOT .NAME(TAGX) )  GO  TO  213 
UPTH( I )=TAGX 

213  CONTINUE 

211  CALL  PAGER ( 1 ) 

WRITE(LP,1110)  (UPTH(I ) ,1=1,15) 

CALL  PTHCKfUPTH, PTLST, MODEL, ISW) 

IF(ISU.EQ.O)  GO  TO  700 


- ERROR  RETURNS  FOR  INVALID  PATH  CODES 

CALL  PAGER (1) 

GO  TO (220, 230 .240,250) , ISW 

220  WRITE(LP»1120) 

GO  TO  700 
230  WRITE(LP, 1130) 

GO  TO  700 
240  WRITE(LP»1140) 

GO  TO  700 
250  WRITE(LP, 1150) 


. SECTION  TO  PRODUCE  MODEL  TEXT  DESCRIPTIONS 

700  CALL  PAGER(2) 

WRITE(LP,7000) 

IF ( .NOT • YESNO(O) )  GO  TO  750 
CALL  PAGER(2) 

WRITE(LP,7010) 

710  IF( .NOT.ENTR(O))  GO  TO  730 
IF(QUEST(0) )  GO  TO  730 
IF( .NOT .NAME(TAGX) )  GO  TO  730 
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IF(TAGX.EQ.EXIT)  GO  TO  750 
DO  720  1=1*29 

IF(TAGX.NE.PTLST(I))  GO  TO  720 
CALL  MODEXPd) 

GO  TO  740 
720  CONTINUE 

CALL  PAGER<2) 

WRITE(LP*7020)  TAGX 
730  CALL  PAGER(2) 

WRITE(LP*7030> 

740  CALL  PAGER(3> 

WRITE(LP*7040) 

GO  TO  710 

750  IF(ISW.EQ.O)  GO  TO  430 
GO  TO  21.2 

7000  FORMAT  (/40H  DO  YOU  NEED  DESCRIPTIONS  OF  THE  MODELS?) 

7010  FORMAT  (/20H  ENTER  MODEL  LETTER!) 

7020  FORMAT  </lX*A10*llH  IS  INVALID) 

7030  FORMAT  (/45H  VALID  LETTER  CODES  ARE  A  TO  Z*  II*  RR.  OR  SS) 

7040  FORMAT  (/21H  TYPE  MODEL  LETTER  0R/27H  TYPE  EXIT  TO  CANCEL  REPORT) 

- READ  CHEMICAL  RECOGNITION  CODE.  TERMINATE  IF  INSTEAD  GET  END 

OF  FILE*  OTHERWISE  AUDIT  INPUT  THEN  STORE.  VALIDATION  OCCURS 
WHEN  PROPERTY  FILE  IS  ACCESSED. 

500  CONTINUE 
510  WRITE(LP*520) 

520  FORMAT  (36H  ENTER  OUTPUT  UNITS  SELECTION  (0-4)!) 

IF ( .NOT.ENTR(O) )  GO  TO  530 
IF ( .NOT. QUEST (0 ) )  GO  TO  540 

C . . USER  TYPED  ? 

CALL  PAGER(8) 

WRITE(LP* 5000) 

GO  TO  510 

50000F0RMAT  </5X*27HTHE  AVAILABLE  OPTIONS  ARE  -/5X.16H0  FOR  ALL  UNITS*/ 
1  5X.16H1  FOR  CGS  UNITS, /5X*15H2  FOR  SI  UNITS*/5X,24H3  FOR  ENGLISH 
2UNITS,  AND/5X, 17H4  FOR  MIXED  UNITS/) 

C . —USER  TYPED  (CR) 

530  CALL  PAGER(3) 

WRITE(LP*5010)  ICVSL 
GO  TO  510 

5010  FORMAT  ( /5X.21HCURRENT  SELECTION  IS  ,11/) 

C - USER  TYPED  VALUE 

540  IF( .NOT . INTEGR< ICVSL) )  GO  TO  510 
N0FF=0 
IPRAC=1 
IPRRP=0 

260  WRITE(LP*2030) 

2030  FORMAT (33H  ENTER  CHEMICAL  RECOGNITION  CODE!) 

IF( .NOT.ENTR(O) )  GO  TO  262 
IF ( .NOT .QUEST(O) )  GO  TO  264 

C . . USER  TYPED  ? 

CALL  PAGER(7) 

MRITE(LP*2060) 

GO  TO  260 

20600FORMAT  (/5X*47HTHE  CHEMICAL  RECOGNITION  CODE  IS  A  THREE-LETTER/5X , 
1  47HALPHABETIC  CODE  USED  TO  SELECT  THE  CHEMICAL  F0R/5X*48HHAZARD  A 
2SSESSMENT .  REFER  TO  CHRIS  MANUAL  II  F0R/5X*50HCR0SS-REFERENCE  LIS 
3TS  OF  CHEMICAL  NAMES*  SYN0NYMS*/5X*22HAND  RECOGNITION  CODES./) 

C . USER  TYPED  (CR) 

262  CALL  PAGER(3) 

WRITE(LP*2070)  ICD 
GO  TO  260 

2070  FORMAT  (/5X.15HCURRENT  CODE  =  *A3/) 

C . USER  TYPED  CODE 

264  IF ( .NOT .NAME( ICD) )  GO  TO  260 
IFLD=1001 

261  CALL  PAGER ( 1 ) 

C 

C . ERROR  IF  FIELD  NUMBER  IS  NOT  1001*  OR  RECOGNITION  CODE  IS  BLANK 

IF ( IFLD.EQ. 1001 )  60  TO  270 
CALL  PAGER(l) 

WRITE(LP* 1180) 
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GO  TO  30 

270  IF(ICD.NE.IBLNK)  GO  TO  280 
CALL  PAGER ( 1 ) 

WRITE<LP*1190) 

GO  TO  30 
C 

C . STORE  RECOGNITION  CODE  IN  STATE  FILE 

280  IF(N0P.NE.4>  GO  TO  310 
LIST<1*1>=1001 
LIST ( 1 *2)=0461 
DO  290  1  =  1 » 3 
J=I+2 

290  LIST C1»J)-TN<I) 

LIST  < 1 *6)=l 
NI  =  1 

IVAL<1*3)=0 
IVAL (1 *2)=0 
300  IVAL(1*1)=ICD 
GO  TO  320 

310  IX*LIST(1*2)/10 
LIST  < 1 *2>=10*IX+1 

IF(N0P.NE.5>  LIST < 1 »2>=LIST ( l»2)+4 
GO  TO  300 
C 

C - READ  BASIC  FIELD  DATA  CARDS*  THEN  BRANCH  ON  NOP 

320  CONTINUE 

GO  TO (330 *340 *350 *355* 360 >* NOP 

C . RUN 

330  STC0N=3 
GO  TO  370 

C . RE-RUN 

340  STC0N=3 
GO  TO  390 

C - CONTINUE 

350  IHSTCON.LT. 3)  STC0N=3 
GO  TO  390 

C . LOAD  DEFAULT 

355  CALL  PAGER<3) 

WRITE(LP*1220)  NF*MNF*NI*MNI 

C - UPDATE  DEFAULT 

360  IF(CNT.EQ.O)  GO  TO  410 
IF(IERR.EQ.l)  GO  TO  410 
STC0H=2 

CALL  ACCESS (STATE* I DFLT *  1  *STCON) 

CALL  PAGER<5) 

WRITE(LP*1200) 

370  DO  380  1=1*2489 
380  SAVE(I)=STATE(I) 

SVCON=STCON 

C - AUDIT  RUN  TINE  OPTIONS  SELECTED 

390  CONTINUE 

CALL  LSTFL(2) 

IF(N0P,GT,3)  GO  TO  400 
INDXX--1 

IF(IPRAC.NE.O)  CALL  PROP(INDXX) 

IF ( INDXX . EQ . 1 )  GO  TO  212 
GO  TO  260 

400  IF(EOFF.EQ.O)  GO  TO  10 
GO  TO  420 
410  CALL  PAGER(3) 

WRITE(LP* 1210) 

420  N0P=0 

GO  TO  430 


1000  FORMAT  (4A4*3X*3( II* IX* II ,7X) ) 

1010  FORMAT  <//5X*30H*m*UNRECOGNIZED  CONTROL  CARD/5X*4A4) 

1020  FORMAT  <//5X*  19H*m*RUN  TERMINATED) 

1025  FORMAT  (10A8) 

1030  FORMAT  (//5X*39HW**tUNEXPECTED  END  OF  FILE  ENCOUNTERED) 
10400F0RMAT  <//5X*33HHACS  STATE  FILE  INITIALIZED  WITH  *A8*29H  VALUES*  F 
1ILE  LABEL  FOLLOWS  -/10X*10A8/) 

1050  FORMAT  (//5X*37HLISTING  OF  USER  INPUT  CARDS  FOLLOWS  -/5X*37(1H-)/) 
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1060  FORMAT  (6X,4A4> 

1070  FORMAT  ( 10X,22H(FILE  DISPLAY  OPTIONS), 5X»3(I1»1X, II, 7X)) 

1080  FORMAT  ( 10X,41H*m«WARNING  -  INVALID  OPTIONS  SUPPRESSED) 

1090  FORMAT  (6X,10A8) 

1100  FORMAT  (15A4) 

1110  FORMAT  (6X, 15A4) 

1120  FORMAT  (5X» 50H****»INPUT  CONTAINS  UNRECOGNIZABLE  RATE  MODEL  CODE) 
1130  FORMAT  <5X>31HtS**tRATE  MODEL  CODES  NOT  GIVEN) 

1140  FORMAT  (5X,51Hm*tM0DEL  CODES  NOT  IN  CORRECT  ASSESSMENT  SEQUENCE) 
1150  FORMAT  (5X.42H*m*RATE  MODEL  CODES  MISSING  IN  USER  LIST) 

1160  FORMAT  ( I4,A4»53X,3A4> 

1170  FORMAT  (6X, I4,A4,53X,3A4> 

11800FORMAT  (5X»60H«mFIELD  NUMBER  MUST  BE  1001  FOR  CHEMICAL  RECOGNIT 
1I0N  CODE) 

1190  FORMAT  (5X,38H*m*CHEMlCAL  RECOGNITION  CODE  MISSING) 

1200  FORMAT  <//5X,47HUPDATE  OF  HACS  DEFAULT  FILE  HAS  BEEN  COMPLETED.//) 
12100F0RMAT  (//5X,66H*m*UPDATE  OF  HACS  DEFAULT  FILE  HAS  BEEN  SUPPRESS 
1ED  DUE  TO  ERRORS) 

12200F0RMAT  (/5X,32HDEFAULT  FILE  STORAGE  UTILIZATIQN/10X»I5,22H  REAL  FI 
1ELDS  DEFINED,  ,IB,10H  ALL0CATED/10X, I5,25H  INTEGER  FIELDS  DEFINED, 
2  ,I5,10H  ALLOCATED) 

430  CALL  TRACE (1,1,0) 

END 

SUBROUTINE  ACCESS < ARRAY , UNI T , I SU , CNT ) 

SUBROUTINE  ACCESS  IS  A  UTILITY  ROUTINE  PROVIDED  TO  READ  OR 
WRITE  HACS  DEFAULT  FILE  VALUES  ON  PERIPHERAL  STORAGE  DEPENDING 
ON  THE  OPTION  SNITCH  ISW.  NOTE  THAT  THE  LENGTH  OF  THE  HACS 
DEFAULT  FILE  IS  EXPLICITLY  REQUIRED  IN  THIS  ROUTINE  TO 
SPECIFY  THE  LENGTH  OF  THE  I/O  ARRAYS. 


ARRAY  *  HACS  DATA  FILE  (STATE  OR  SAVE)  INTO  OR  FROM  WHICH 
DEFAULT  VALUES  ARE  LOADED 
HACS  FILE  CONTROL  VARIABLE  SET  TO  2  FOR  FILE 
INITIALIZED  TO  DEFAULT  VALUES 
>  OPTION  SWITCH  SET  IN  CALLING  PROGRAM  TO  READ  (0)  OR 
WRITE  (1)  DEFAULT  VALUES 
LOOP  INDEX 

FORTRAN  UNIT  NUMBER  FOR  PERIPHERAL  STORAGE  OF  DEFAULT 
FILE  VALUES 


CNT 

ISW 

J 

UNIT 


COMMON  VARIABLES  USED  -  NONE 

SUBROUTINES  REQUIRED  -  NONE 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC. 

35/309A  ACORN  PARK, 
CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  18  NOVEMBER  1975 


DIMENSION 

INTEGER 


ARRAY < 1 ) 
CNT, UNIT 


C 

C- 


- BRANCH  ON  OPTION  SWITCH  TO  READ  OR  WRITE  DEFAULT  FILE.  TO 

READ,  COPY  ALL  DEFAULT  VALUES  TO  ARGUMENT  ARRAY  AND  SET  FILE 
CONTROL  VARIABLE  TO  2  FOR  DEFAULT  VALUES. 

IF ( ISW.EQ. 1 )  GO  TO  20 
REWIND  UNIT 

READ(UNIT)  (ARRAY ( J) , J*1 ,2489) 

CNT=2 

RETURN 


. UPDATE  DEFAULT  FILE  STORED  ON  PERIPHERAL  FILE 

20  REWIND  UNIT 

WRITE(UNIT)  (ARRAY (J) ,J« 1,2489) 

RETURN 


END 

SUBROUTINE  BASIC(NOP»IERR»EOFF,CNT) 
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SUBROUTINE  BASIC  READS*  VALIDATES  AND  STORES  INPUT  FIELD  DATA 
CARDS  IN  THE  HACS  STATE  FILE  UNDER  CONTROL  OF  THE  AROUNENT 
NOP  WHICH  HAS  VALUES  ON  INPUT  AS  FOLLOWS  - 

1  RUN  OPTION*  FIELD  CARDS  GIVE  USER  VALUES 

2  RE-RUN  OPTION*  FIELD  CARDS  GIVE  USER  VALUES 

3  CONTINUE  OPTION*  FIELD  CARDS  GIVE  USER  VALUES 

4  LOAD  DEFAULT  OPTION*  FIELD  CARDS  GIVE  DEFAULT  VALUES 

5  UPDATE  DEFAULT*  FIELD  CARDS  GIVE  DFFAULT  VALUES 

THE  ROUTINE  PROCESSES  ALL  FIELD  DATA  CARDS  (EXCEPT  FOR  FIELD 
1001  GIVING  THE  CHEMICAL  RECOGNITION  CODE)  UNTIL  EITHER  A 
FIELD  9999  CARD  OR  AN  END  OF  FILE  IS  ENCOUNTERED.  ON  RETURN* 
CNT  GIVES  THE  COUNT  OF  FIELD  DATA  CARDS  READ*  AND  IERR  IS  0  IF 
NO  ERRORS  HERE  IDENTIFIED.  IERR  IS  SET  TO  ONE  IF  AT  LEAST 
ONE  ERROR  WAS  DETECTED.  ON  RETURN*  THE  INDICATOR  EOF  IS  SET  TO 
-1  IF  AN  END  OF  FILE  WAS  ENCOUNTERED*  0  OTHERWISE.  AN  OUTPUT 
LISTING  OF  EACH  DATA  CARD  IS  PRODUCED*  FOLLOWED  BY  ERROR 
MESSAGES  AND/OR  FIELD  VALUE  CONVERSIONS*  IF  ANY.  THE  GENERAL 
NATURE  OF  THE  PROCESSING  FOR  EACH  TYPE  OF  FIELD  DATA  CARD  IS 
INDICATED  BELOW  - 

FOR  NOP  =  1*  2*  OR  3 

READ  USER  DATA  CARD  CONTAINING 
IFLD»FVL*TAG  ...  WHERE  - 

1.  IFLD  IS  EITHER  9999  TO  DENOTE  END  OF  DATA.  OR  IFLD 

IS  A  PREVIOUSLY  DEFINED  FIELD  NUMBER  IN  THE 
RANGE  2  TO  9998. 

2.  TAG  IS  EITHER  BLANK  OR  MATCHES  AN  ALLOWABLE  UNIT 

LABEL  FOR  THE  TYPE  OF  PHYSICAL  QUANTITY  DEFINED 
FOR  FIELD  IFLD.  IF  TAG  IS  BLANK,  THE  VALUE  FVL 
IS  ASSUMED  TO  BE  IN  INTERNAL  (CGS)  UNITS  AND  IS 
NOT  CONVERTED.  FIELD  VALUE  CONVERSIONS  ARE 
APPLIED  ONLY  TO  REAL  FIELD  VALUES,  NOT  INTEGERS 

3.  IF  THE  VALUE  FVL  EXCEEDS  THE  NOMINAL  BOUNDS  DEFINED 

IN  THE  DEFAULT  FILE,  A  WARNING  MESSAGE  IS 
GENERATED  BUT  THE  VALUE  IS  STORED.  HOWEVER* 

FOR  INTEGER  FIELDS,  IF  THE  VALUE  GIVEN  EXCEEDS 
AN  INTERNAL  LIMIT  (ITOL),  A  FIELD  JUSTIFICATION 
ERROR  IS  ASSUMED.  IN  THIS  CASE  AN  ERROR 
MESSAGE  IS  GENERATED  AND  THE  FIELD  VALUE  IS 
NOT  STORED. 

FOR  NOP  =  4*  READ  DEFAULT  DATA  CARD  CONTAINING 

IFLD. FVL*TAG*IVAR*MN*FMN*FMX,ITYP,<IN< I), 1*1 *3>... WHERE  - 

4.  IFLD  IS  EITHER  9999  TO  DENOTE  END  OF  DATA*  OR  IFLD 

IS  A  VALID  FIELD  NUMBER  IN  THE  RANGE  2  TO  9998 
WHICH  HAS  NOT  BEEN  DEFINED  BY  A  PREVIOUSLY 
ENTERED  CARD. 

5.  THE  INDICATOR  IVAR  DEFINES  THE  INTERNAL  STORAGE  MODE 

FOR  THE  FIELD  VALUE  (0  FOR  INTEGER,  1  FOR  READ 

6.  THE  NIN/MAX  SELECTOR  MM  MUST  BE  GIVEN  AS  3  INDICATING 

THAT  BOTH  MINIMUM  AND  MAXIMUM  NOMINAL  BOUNDS 
ARE  GIVEN  FOR  THE  DEFAULT  FILE  DEFINITION. 

7.  THE  FIELD  NAME,  1  TO  12  ALPHANUMERIC  CHARACTERS  READ 

INTO  <IN(I),I*1,3>*  MUST  NOT  BE  BLANK. 

8.  THE  TYPE  OF  PHYSICAL  QUANTITY  GIVEN  BY  ITYP  MUST  BE 

IN  THE  RANGE  1  TO  MTYP ,  CORRESPONDING  TO  A 
PRE-DEFINED  QUANTITY  TYPE. 

9.  SEE  NOTE  2  ABOVE  FOR  VALIDATION  OF  THE  UNIT  LABEL 

TAG.  ALSO*  FOR  DEFAULT  DATA*  INPUT  CONVERSIONS 
ARE  APPLIED  TO  THE  FIELD  VALUE  AND  BOTH  RANGE 
LIMITS  FOR  REAL  FIELDS.  INPUT  CONVERSIONS  ARE 
NOT  APPLIED  TO  INTEGER  FIELDS. 

10.  IF  THE  FIELD  VALUE  FVL  IS  NOT  WITHIN  THE  BOUNDS 

GIVEN*  AN  ERROR  MESSAGE  IS  GENERATED*  AND  THE 
FIELD  DEFINITION  IS  CANCELLED.  ALSO*  FOR 
INTEGER  FIELDS*  THE  VALUE  AND  RANGE  LIMITS  ARE 

ITOL  TO  TEST  FOR 


sses8§18,  TP I  1 35If  SF ,  gsv  YS»1 1 


FOR  NOP  *  S* 


READ  DEFAULT  FILE  UPDATE  CARD  CONTAINING 
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WHERE  - 


CNT 

CR 

D 

EOF 

FAC 

FBLNK 

FMN 

FHX 

FVL 

I 

IBLNK 

IERR 

IFLD 

ILN 

IHN 

IHX 

IN 

ISRC 

ISW 

ISYS 

ITOL 

ITYP 

IVAR 

IVL 

IX 

J 

JSYS 

HM 


IFLD*FVL*TAG*MM*FMN*FHX*  <IN( I) *1=1 *3)  ... 

11.  SEE  NOTE  1  ABOVE. 

12.  THE  MIN/HAX  SELECTOR  HH  IS  GIVEN  AS 

0  NEITHER  UNIT  UPDATED 

1  MINIMUM  VALUE  GIVEN 

2  MAXIMUM  VALUE  GIVEN 

3  NEW  VALUES  GIVEN  FOR  BOTH  LIMITS 

13.  THE  FIELD  NAME  (IN(I)»I=1»3)  IS  REPLACED  BY  THE  USER 

SPECIFIED  LABEL  IF  NON-BLANK.  OTHERWISE  THE 
NAME  STORED  IN  THE  DEFAULT  FILE  IS  UNCHANGED. 

14.  SEE  NOTE  2  ABOVE.  IN  ADDITION*  INPUT  CONVERSIONS* 

IF  ANY*  ARE  APPLIED  TO  ALL  RANGE  LIMITS  GIVEN 
FOR  REAL  FIELDS  (AS  SPECIFIED  BY  MM) 

15.  SEE  NOTE  10  ABOVE.  RANGE  LIMIT  TESTS  USE  UPDATED 

VALUES  AS  REQUESTED. 


ARGUMENT*  INTEGER  COUNT  OF  FIELD  DATA  CARDS  READ 
EXCLUDING  9999  OR  END  OF  FILE  TERMINATORS 
INTEGER  FORTRAN  UNIT  NUMBER  FOR  CARD  READER 
CONVERSION  FACTOR  FOR  REAL  FIELD  OBTAINED  FROM  DATA 
ARRAY  CONV 

ARGUMENT*  RETURNED  AS  -1  IF  AN  END  OF  FILE  WAS 

ENCOUNTERED  WHEN  READING  FIELD  DATA  CARDS.  OTH 
WISE  RETURNED  AS  0 

ARRAY  OF  CONVERSION  FACTORS  FOR  TEMPERATURE  FIELDS 
REAL  DATA  WORD  CONTAINING  ALL  BLANKS  USED  TO  TEST 
UNIT  LABEL  FIELD  TAG 

LOWER  LIMIT  RANGE  VALUE  ENTERED  ON  USER  INPUT  CARD 
IN  FIXED  POINT  FORMAT 

UPPER  LIMIT  RANGE  VALUE  ENTERED  ON  USER  INPUT  CARD 
IN  FIXED  POINT  FORMAT 

FIELD  VALUE  ENTERED  ON  USER  INPUT  CARD  IN  FIXED 
POINT  FORMAT 
DUMMY  SUBSCRIPT 

INTEGER  DATA  WORD  CONTAINING  ALL  BLANKS  USED  TO  TEST 
FIELD  NAME  INPUT 

ARGUMENT*  RETURNED  AS  1  IF  ONE  OR  MORE  INPUT  ERRORS 
WERE  FOUND*  0  OTHERWISE. 

FIELD  NUMBER  ENTERED  ON  USER  INPUT  CARD 
INDEX  TO  POSITION  IN  STATE  FILE  FIELD  DEFINITION 
ARRAY  CORRESPONDING  TO  FIELD  IFLD. 

LOWER  LIMIT  RANGE  VALUE  FOR  INTEGER  FIELD*  OBTAINED 
FROM  DEFAULT  FILE  OR  CONVERSION  OF  INPUT  VALUE  FMN 
UPPER  LIMIT  RANGE  VALUE  FOR  INTEGER  FIELD*  OBTAINED 
FROM  DEFAULT  FILE  OR  CONVERSION  OF  INPUT  VALUE  FHX 
ARRAY  FOR  STORAGE  OF  USER  SPECIFIED  FIELD  NAME  CON¬ 
TAINING  UP  TO  12  CHARACTERS  STORED  AS  3A4. 

FIELD  VALUE  SOURCE  CODE  IN  STATE  FILE  BEFORE  USER 
FIELD  TRANSACTION  IS  STORED 
CONTROL  SWITCH  SET  TO  0  IF  INPUT  FOR  FIELD  NAME  IS 
BLANK*  1  IF  NON-BLANK*  FOR  HANDLING  OPTIONAL  CHANGE 
ON  DEFAULT  FILE  UPDATE 

INTEGER  IN  RANGE  1  TO  MSYS  DETERMINED  BY  MATCHING 
UNIT  TAG  TO  PRE-DEFINED  LABELS  FOR  THE  PARTICULAR 
TYPE  OF  PHYSICAL  QUANTITY,  IF  TAG  IS  BLANK  OR  THE 
SAME  AS  INTERNAL  HACS  UNITS*  ISYS  IS  COMPUTED  AS  1 
AND  CONVERSION  ON  INPUT  IS  SKIPPED. 

INTEGER  TOLERANCE  LEVEL  SET  AS  DATA  VALUE  FOR  TESTING 
FIELD  JUSTIFICATION  OF  INTEGER  VALUES  ON  INPUT 
TYPE  OF  PHYSICAL  QUANTITY  FOR  INDIVIDUAL  FIELD  IN 
RANGE  1  TO  MTYP 

INTERNAL  FIELD  VALUE  STORAGE  MODE  INDICATOR 
(0  FOR  INTEGER*  1  FDR  REAL) 

FIELD  VALUE  FOR  INTEGER  FIELD*  OBTAINED  FROM  INPUT 
CARD  BY  CONVERSION  OF  FVL 

INDEX  TO  POSITION  IN  FIELD  VALUE  DATA  ARRAYS  FVAL  OR 
IVAL  CORRESPONDING  TO  FIELD  DEFINITION  IN  ARRAY  LIST 
DUMMY  SUBSCRIPT 

INDEX  TO  CONVERSION  FACTOR  DATA  ARRAY  CORRESPONDING 
TO  ISYS-1  WHERE  ISYS  INDEXES  THE  UNIT  LABEL  DATA 
MIN/HAX  SELECTOR  USED  TO  SPECIFY  WHICH  RANGE  VALUES 
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HAVE  BEEN  ENTERED  ON  USER  DATA  CARD  <0=NEITHER* 
1«HIN  ONLY *  2SMAX  ONLY*  3=B0TH  MIN  AND  MAX) 

NFLD  *  TOTAL  NUMBER  OF  FIELDS  DEFINED  IN  MACS  STATE  FILE 
NOP  =  CONTROL  SELECTOR  DETERMINED  FROM  USER  SPECIFIED 
PROCESSING  OPTION 

SEQ  =  REAL  VARIABLE  USED  TO  READ  AND  DISPLAY  CONTENTS  OF 
SEQUENCE  FIELD  ON  INPUT  "ARD 

TAG  =  FIELD  ON  USER  INPUT  CARD  )R  UNIT  LABEL  IN  A8  FORMAT 

COMMON  VARIABLES  USED  -  CONV*FVAL.IVAL*LIST*LP.MNF.MNI*MSYS. 

MTYP.NF.NI.UNIT 

SUBROUTINES  REQUIRED  -  IABS*IFEOF*IFIX* PAGER 

AUTHOR  -  R.G.  POTTS*  ARTHUR  D.  LITTLE*  INC.* 

35/309A  ACORN  PARK 
CAMBRIDGE*  MASS.*  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  12  FEBRUARY  1976 

0C0MM0N/BASE/SAVE(2489) »UPTH< 15 ) *MSG< 10) *MNF  *MNI > 

1  NF*NI *LIST(275»6) *FVAL(225>3) * IVAL (50*3) 

INTEGER  UPTH 

REAL  MSG 

DIMENSION  STATE(2489) 

EQUIVALENCE  (STATE < 1 ) »MSG( 1 > ) 

COHMON/CNVDT/CONV( 3*47) *MSYS*MTYP*UNIT(4*47) 

COMMON/HEAD/DTE  »LNCT*LNPG*LP* NPG* TITLE ( 10) 


INTEGER  CNT.CR.EOFF 
DIMENSION  FAC(3) * IN(3) 

DATA  CR/60/ *FBLNK/8H  /*1BLNK/4H 

DATA  (FAC( I ).I*lr3)/l. 0*1. 8*1.0/ 


/* ITDL/10000/ 


. INITIALIZATION  SECTION.  SET  VARIABLE  VALUES.  THEN  BRANCH  ON 

OPERATION  FLAG  TO  PRINT  HEADER  FOR  DATA  INPUT  LISTING 
CNT«0 
E0FF=0 
IERR=0 
NFLD*NF+NI 
CALL  PAGER(3) 

GO  T0( 10* 10* 10*20*30) *N0P 

10  HRITE(LP.IOOO) 

GO  TO  40 

20  URITE(LP* 1010) 

GO  TO  40 

30  URITE(LP>1020) 


. RETURN  HERE  TO  READ  EACH  NEW  USER  INPUT  CARD 

40  READ(CR*1030)  IFLD*FVL*TAG* IVAR*MM*FMN*FMX*1TYP* (IN(I) *1=1*3) *SEQ 


. TEST  FOR  TERMINATION.  RETURN  ON  END  OF  FILE  OR  END  OF  DATA 

CARD.  OTHERWISE  INCREMENT  COUNT  OF  USER  DATA  CARDS  READ. 
IF(EQF (CR) >50*60 
50  E0FF*-1 

CALL  PAGER(3> 

HRITE(LP* 1040) 

RETURN 

60  IF(IFLD.NE.9999)  GO  TO  70 
CALL  PAGER<3> 

URITE(LP* 1050) 

RETURN 
70  CNT*CNT41 


. LOOK  UP  FIELD  NUMBER  READ  ON  INPUT  CARD  IN  HACS  STATE  FILE 

ILN«1 

80  ILN*ILN+1 
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IF(ILN.GT.NFLD)  GO  TO  85 
IF <IFLD<EQ<LIST ( ILNr 1 ) )  GO  TO  130 
GO  TO  80 
85  CONTINUE 


. FIELD  NUMBER  WAS  NOT  FOUND  IN  MACS  STATE  FILE.  INDEX  ILN 

POINTS  TO  NEXT  AVAILABLE  SLOT  IN  FILE  FOR  ENTERING  DEFAULT 
DATA.  AN  ERROR  EXISTS  FOR  OTHER  OPERATIONS. 

IF(N0P.E0.4>  GO  TO  110 
CALL  PAGER(l) 

WR1TE(LP» 1060)  IFLD 
90  CALL  PAGER(l) 

WR1TE(LP.1070) 

IERR= 1 
GO  TO  40 


. DISPLAY  CONTENTS  OF  DATA  CARD  READ  TO  CREATE  DEFAULT  FILE 

ENTRY.  USE  EITHER  INTEGER  OR  REAL  (BY  DEFAULT)  FORMAT 
110  CALL  PAGER(l) 

IF ( IVAR.EQ.O)  GO  TO  120 

WRITE(LP» 1080)  IFLD.FVL .TAG.IVAR.MH.FHN.FMX.ITYP .<IN(I), 1=1.3) »SEO 
GO  TO  180 
120  IVL=IFIX(FVL) 

IMN=IFIX(FMN) 

IMX»IFIX(FMX) 

WRITE (LP. 1090)  IFLD. IVL.TAG. IVAR.HM. IMN. IMX. ITYP.  <IN(I)»I=1»3)»SEQ 
GO  TO  180 


. FIELD  NUMBER  READ  FROM  INPUT  MATCHED  ENTRY  IN  STATE  FILE. 

ERROR  CONDITION  FOR  ENTERING  DEFAULT  DATA.  OTHERWISE  UNCODE 
INFORMATION  IN  STATE  FILE  AND  AUDIT  INPUT. 

130  IF(N0P,NE.4)  GO  TO  140 
CALL  PAGER(l) 

WRITE(LP.llOO)  IFLD 
GO  TO  90 

140  IVAR=LIST ( ILN.2)/1000 
ISRC=1000f IVAR 
ITYP=(LIST ( ILN»2)-ISRC)/10 
ISRC=LIST(ILN»2)-10*ITYP-ISRC 

IX=LIST(ILN.6) 

CALL  PAGER(l) 

IF(N0P.NE.5)  GO  TO  160 
IF(IVAR.EQ.O)  GO  TO  150 

WRITE(LP.lllO)  IFLD.FVL .TAG.MM.FMN.FMX. ( IN(I).I=1.3> . SEQ 
GO  TO  210 
150  IVL=IFIX(FVL) 

IMN=IFIX(FMN ) 

IMX=IFIX(FMX) 

WRITE(LP. 1120)  IFLD.IVL,TAG.HN.IMN.INX.<IN<I),I=1.3).SEQ 
GO  TO  210 

160  IF ( IVAR.EQ.O)  GO  TO  170 
FMN=FVAL(IX»2) 

FMX=FVAL(IX.3) 

WRITE(LP»1080)  IFLD.FVL.TAG 
GO  TO  280 
170  IVL=IFIX(FVL ) 

IMN*IVAL( IX.7) 

IHX=IVAL<IX.3> 

WRITE(LP.1090>  IFLD. IVL.TAG 
GO  TO  280 


. TEST  FOR  VALID  FIELD  NUMBER 

180  IF ( IFLD.LT . 1)  GO  TO  190 
IF ( IFLD, LE. 9998)  GO  TO  200 
190  CALL  PAGER ( 1 ) 

WRITE(LP. 1130) 

GO  TO  90 


-TEST  FOR  VALID  STORAGE  MODE  INDICATOR.  NOTE  THAT  IF  IVAR*0» 
IVL.  INN  AND  I MX  HAVE  ALREADY  BEEN  OBTAINED  FOR  AUDIT. 
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200  IF(IVAR.EO.O)  60  TO  210 
IF ( I VAR.EQ. 1 )  GO  TO  210 
CALL  PAGER(l) 

URITE(LP» 1140) 

GO  TO  90 


.  --TEST  MINIMUM/NAXIMUM  INPUT  DATA  SELECTOR 

210  IF(HM.LT.O)  GO  TO  220 
IF(MM.GT.3)  GO  TO  220 
IF<N0P.EQ.5)  GO  TO  230 
IF(MM.EQ.3)  GO  TO  230 
220  CALL  PAGER (1) 

WRITE(LPf 1 150) 

GO  TO  90 


. —TEST  FOR  NON-BLANK  FIELD  NAME  (ISU=1)< 

230  ISW=1 

DO  240  1=1*3 

IF ( IN< I ) . NE . IBLNK)  GO  TO  250 
240  CONTINUE 
ISW=0 

IF<N0P.EQ.5>  GO  TO  290 
CALL  PAGER ( 1 ) 

WRITE(LPf1160) 

GO  TO  90 

250  IF(N0P.EQ.5)  GO  TO  290 


. TEST  TYPE  CODE.  MUST  BE  IN  RANGE  OF  DEFINED  TYPES  OF 

PHYSICAL  QUANTITIES. 

IF ( ITYP.LT • 1 )  GO  TO  270 
IF(ITYP.LE.MTYP)  GO  TO  290 
270  CALL  PAGER < 1 ) 

URITE(LPf 1170)  MTYP 
GO  TO  90 


- SET  PARAMETERS  FOR  NOP  »  1 f  2  OR  3 

280  MM=0 
ISU=0 


. -VERIFY  UNIT  LABEL  SPECIFICATION,  CONVERSION  TO  INTERNAL  UNITS 

IS  REQUIRED  UNLESS  ISYS  IS  DETERMINED  TO  BE  1 . 

290  ISYS=1 

IF(TAG.EQ.FBLNK)  GO  TO  310 
300  IF(TAG.EQ.UNIT(ISYSfITYP>>  GO  TO  310 

TSYSsTRYS+l 

IF( ISYS.LE.MSYS)  GO  TO  300 
CALL  PAGER(l) 

MRITE(LPf1180) 

GO  TO  90 


. SEPARATE  PROCESSING  FOR  INTEGER  AND  REAL  FIELDS 

310  IF(IVAR.EQ.O)  GO  TO  450 


- CONVERT  REAL  FIELD  VALUES  IF  NECESSARY 

IF ( ISYS.EQ. 1 )  GO  TO  330 

JSYS=ISYS-1 

D=CONV(JSYSfITYP) 

IF ( ITYP.NE. A)  GO  TO  315 
FVL=(FVL-D) /FAC (JSYS) 

60  TO  316 

315  FVL=D*FVL 

316  CALL  PAGER ( 1 ) 

IFINOP.GT .3)  GO  TO  320 
MRITE(LPf1190)  FVLfUNIT(IfITYP) 

GO  TO  330 

320  IF(ITYP.NE,6)  GO  TO  321 
FMN*(FMN-D)/FAC(JSYS) 

FMX*(FMX-D) /FAC (JSYS) 

GO  TO  322 

321  FMN»DtFMN 
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FMX=D*FMX 

322  HRITE(LPf 1190)  FVL»UNIT ( 1 » 1TYP)  »FHN»FHX 


. FOR  OPERATIONS  TO  CHANGE  DEFAULT  VALUES t  RESTORE  UNCHANGED 

LIMITS  FROM  DEFAULT  FILE 
330  IF(N0P.NE.5)  GO  TO  360 
IF(MM.NE.O)  GO  TO  350 
FMN*FVAL( I X  f  2  > 

340  FMX=FVALdX»3) 

GO  TO  360 

350  IF(MM.EQ.3)  GO  TO  360 
IFfMM.EQ. 1 )  GO  TO  340 
FHN=FVAL( IXf 2) 


. CHECK  RANGE  OF  REAL  VARIABLE 

360  IF(FVL.LT.FMN)  GO  TO  370 
IF(FVL.LE.FMX)  GO  TO  380 
370  CALL  PAGER(l) 

URITE(LP» 1200)  FMN»FMX»UNIT< 1  * ITYP) 
IF(N0P«GT.3)  GO  TO  90 


. STORE  REAL  VALUES  IN  STATE  FILE 

380  IF(NOP.EQ«4)  GO  TO  390 
IF<N0P.EQ.5)  GO  TO  410 
FVALdX*  1  )=FVL 

LIST(ILN»2)=LIST( ILN.2) -ISRC+5 
GO  TO  40 

390  IF(NF.LT.HNF)  GO  TO  400 
CALL  PAGER (1 ) 

WRITE(LPf 1210)  MNF 
GO  TO  90 
400  NF=NF+1 

NFLD=NFLD+1 

IX=NF 

LIST (ILN»1)=IFLD 

LIST (ILN»2)=1001+10*ITYP 

LIST(ILNt6)=NF 

GO  TO  420 

410  LIST(ILN»2)=LIST(ILNr2)-ISRC+l 
420  FVAL(IX»1 )=FVL 
FVAL(IX»2)=FMN 
FVAL( IX»3)=FHX 
430  IF(ISU.EQ.O)  GO  TO  40 
DO  440  1  =  1 » 3 
J=I+2 

440  LISTdLNf J)  =  IN(I> 

GO  TO  40 


. TEST  FOR  REQUESTED  CONVERSION  OF  INTEGER  FIELD  VALUES 

450  IF(ISYS.EQ.l)  GO  TO  460 
CALL  PAGER(l) 

URITE(LP» 1220) 


- TEST  FOR  CORRECT  FIELD  JUSTIFICATION  OF  INTEGER  VALUES 

460  IF( IABS( IVL) . GT . ITOL )  GO  TO  470 
IF(N0P.LE.3)  GO  TO  480 
IF(IABSdHN)  «GTt  ITOL)  GO  TO  470 
IF(IABSdHX).LE.ITOL)  GO  TO  480 
470  CALL  PAGER  U) 

URITE(LP> 1230)  ITOL 
GO  TO  90 


. COMPARE  INTEGER  FIELD  VALUE  TO  NOMINAL  RANGE  LIMITS.  FOR 

OPERATIONS  TO  CHANGE  DEFAULT  VALUES.  FIRST  RESTORE  UNCHANGED 
LIMITS  FROM  DEFAULT  FILE. 

480  IF(N0P.NE.5)  GO  TO  510 
IF(MM.NE.O)  GO  TO  500 
IMN=IVAL( IX»2) 

490  IMX-IVALdX.3) 

GO  TO  510 

500  IF(MM.EQ.3)  GO  TO  510 
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I F ( HM « EQ • 1 )  60  TO  490 
INN»IVAL(IX.2) 

C 

C . COMPARE  TO  NOMINAL  LIMITS 

510  IF(IVL.LT.IMN)  60  TO  520 
IF(IVL.LE.IMX)  60  TO  530 
520  CALL  PA6ER(1) 

WRITE(LP» 1240)  IMN»IMX»UNIT<1.1TYP) 
IFINOP.GT .3)  GO  TO  90 
C 

C - STORE  INTEGER  VALUES  IN  STATE  FILE 

530  IF<N0P.E0.4>  60  TO  540 
IF<N0P.EQ.5>  GO  TO  560 
IVAL(IX» 1 )=IVL 

LIST dLN.2)=LISTdLN.2)-ISRC+5 
60  TO  40 

540  IF(NI.LT.MNI)  GO  TO  550 
CALL  PA6ER(1) 

WRITE(LP.1250)  MNI 
GO  TO  90 
550  NI=NI+1 

NFLD=NFLD+1 

IX=NI 

LIST  < ILN. 1 )=IFLD 
LISTdLN»2)=lF10*ITYP 
LISTdLN»6)=NI 
GO  TO  570 

560  LISTdLN.2)=LISTdLN.2)-ISRC  +  l 
570  IVALdX»l)  =  IVL 
IVALdX»2)  =  IMN 
IVALdX.3)  =  IMX 
GO  TO  430 


10000F0RMAT  (5X.5HFIELD/5X.31HNUMBER  FIELD  VALUE  UNIT/5X. 

1  6UH-)»2X.15dH-).2X,8UH-5) 

10100F0RMAT  <5X»5HFIELD,30X.8HI=0  MIN/5X.95HNUMBER  FIELD  VALUE 

1  UNIT  R=1  MAX  NOMINAL  MINIMUM  NOMINAL  MAXIMUM  TYPE  FIELD  N 
2AME.4X»7HC0MMENT/5X»6(1H-) »2X»15t 1H-) »2X.8dH-)»2(2X.3dH->). 

3  2<2X.15dH-)),2X,4dH-).2X,12UH->.2X»7(lH->> 

10200F0RMAT  (5X.5HFIELD.30X.8H  MIN/5X.95HNUMBER  FIELD  VALUE 

1  UNIT  MAX  NOMINAL  MINIMUM  NOMINAL  MAXIMUM  FIELD  N 

2AME.4X»7HC0MMENT/5X.6UH-).2X»15aH-).2X.8dH->»2(2X.3dH-)). 

3  2(2X»15dH-))»2X»4dH-)»2X»12dH-)»2X»7(lH-)) 

1030  FORMAT  d4.F15.0. A8.2I1 .2F15.0. 12* 3A4.A7) 

1040  FORMAT  (5X.11HEND  OF  FILE//) 

1050  FORMAT  (6X.4H9999//) 

1060  FORMAT  <5X»39H*m*ERR0R  -  UNDEFINED  FIELD  NUMBER  =  (.I4.1H)) 

1070  FORMAT  dOX.21HINPUT  DATA  IS  IGNORED) 

10800F0RMAT  (6X.I4.5X.G13.4. 2X. A8.3X.I1 .4X. II »5X»G13.4>4X>G13.4,3X» 

1  I2.3X.3A4.2X.A7) 

10900F0RMAT  <6X. I4.8X. I 10.2X.A8.3X. II »4X> II »8X» I10.7X. I10.3X. I2.3X. 

1  3A4.2X.A7) 

11000F0RMAT  (5X.48H**»**ERR0R  -  PREVIOUSLY  DEFINED  FIELD  NUMBER  =  <» 

1  I4»1H> ) 

1110  FORMAT  <6X.I4»5X.G13.4.2X»A8.8X.I1.5X»G13.4.4X»G13.4,8X.3A4.2X.A7> 
1120  FORMAT  (6X.I4 .8X. I10.2X. A8.8X. 1 1 .8X. I10»7X* 1 10.8X.3A4.2X. A7) 
11300FDRMAT  (5X»65H*m*ERR0R  -  ILLEGAL  FIELD  NUMBER  NOT  IN  RANGE  1  TO 


19998.  OR  9999) 
11400FORMAT  (5X.73Htf «**ERROR 
1R  OR  1  FOR  REAL  FIELD) 
1150  FORMAT  (5X.44H**«**ERR0R 
1160  FORMAT  <5X.34H*m*ERR0R 
11700F0RMAT  (5X. 57H****»ERR0R 
11  TO  .12) 

1180  FORMAT  (5X.51H*«*MERR0R 


-  STORAGE  MODE  INDICATOR  NOT  0  FOR  INTEGE 

-  ILLEGAL  MIN/HAX  INDICATOR  VALUE) 

-  FIELD  NAME  IS  MISSING) 

-  TYPE  OF  PHYSICAL  QUANTITY  NOT  IN  RANGE 


1180  FORMAT  (5X.51H**«MERR0R  -  UNIT  LABEL  INCONSISTENT  WITH  TYPE  CODE) 
1190  FORMAT  aiX»lH«»4X.G13.4.2X>A8.14X.G13.4.4X»G13.4> 

12000FORMAT  <5X.46HtmtWARNING/ERR0R  -  FIELD  VALUE  NOT  IN  RANGE  . 

1  613. 4. 4H  TO  .613.4. IX. A8) 

12100F0RMAT  (5X.60H***»*ERR0R  -  NUMBER  OF  REAL  FIELDS  DEFINED  EXCEEDS  L 
1IMIT  OF  .13) 

12200F0RMAT  (5X.64H*«***WARNING  -  CONVERSION  OF  INTEGER  FIELD  VALUES  NO 
IT  APPLICABLE) 


lb 
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12300F0RMAT  (5X, 70H*m*ERR0R  -  INTEGERS  MUST  BE  RIGHT  JUSTIFIED.  VALUE 
1  EXCEEDS  LIMIT  OF  .110) 

12400F0RMAT  (5X,46H**mWARNING/ERR0R  -  FIELD  VALUE  NOT  IN  RANGE  . 

1110. 4H  TO  .I10.1X.A8) 

12500F0RMAT  (5X,63Htm*ERR0R  -  NUMBER  OF  INTEGER  FIELDS  DEFINED  EXCEED 
IS  LIMIT  OF  .13) 

■* 

END 

SUBROUTINE  BNDCK ( I SW » TEMP . I TEMP . NFTLO » NFTUP ) 

SUBROUTINE  BOUND  CHECK  COMPARES  THE  REQUESTED  TEMPERATURE  TF.MP 
TO  THE  BOUNDS.  IF  ANY,  DEFINED  FOR  A  TEMPERATURE  FUNCTION.  THE 
ARGUMENT  ISW  PROVIDES  A  CONTROL  PARAMETER  SO  THAT  THE 
TEMPERATURE  BOUNDS,  DEFINED  AS  FIELDS  NFTLO  AND  NFTUP  IN  THE 
STATE  FILE,  ARE  RETRIEVED  ONLY  ONCE  AND  STORED  FOR  LATER  USE 
IN  COMMON  AS  THE  VALUES  TLO  AND  TUP,  HAVING  SOURCE  CODES  ILO 
AND  IUP,  RESPECTIVELY.  A  MESSAGE  IS  GENERATED  IF  THE  REQUESTED 
TEMPERATURE  EXCEEDS  A  BOUNDING  VALUE.  THE  TEMPERATURE  VALUE 
IS  SET  TO  THE  LIMIT  ONLY  IF  THE  EXCEEDED  FOUND  IS  GIVEN  WITH 
A  SOURCE  CODE  OF  GREATER  THAN  DEFAULT.  IF  ADJUSTED  THE 
TEMPERATURE  SOURCE  CODE  IS  CHANGED  TO  NOT  EXCEED  AN  ESTIMATED 
PROPERTY  VALUE.  THE  SOURCE  CODE  FOR  THE  COMPUTED  FUNCTION 
VALUE  IS  OBTAINED  AS  THE  MINIMUM  OF  ALL  SOURCE  CODES  ON  THE 
RIGHT-HAND  SIDE  OF  THE  TEMPERATURE  FUNCTION  EQUATION.  THUS 
IF  ANY  DEFAULT  VALUES  HAVE  BEEN  USED,  THE  TEMPERATURE  FUNCTION 
VALUE  UILL  BE  COMPUTED  FOR  DISPLAY,  BUT  THE  PRIORITY  STRUCTURE 
WILL  NOT  PERMIT  THE  COMPUTED  VALUE  TO  BE  SAVED  IN  THE  STATE 
FILE.  FINALLY,  THE  ROUTINE  WRITES  THE  VALUE  OF  TEMPERATURE 
TO  BE  USED  IN  THE  COMPUTATION. 

IERR  =  DATA  BASE  RECALL  ERRDR  INDICATOR,  NOT  USED.  ERRORS. 

IF  ANY,  ALSO  RETURN  SOURCE  CODE  OF  ZERO  WHICH  IS 
USED  INSTEAD  OF  SEPARATE  ERROR  PROCESSING 
ISW  =  ARGUMENT,  SET  TO  1  ON  FIRST  CALL  TO  FORCE  RETRIEVAL 
OF  TEMPERATURE  BOUNDS  FROM  STATE  FILE  AND  STORAGE 
IN  COMMON.  SET  TO  2  ON  SECOND  CALL  TO  USE  VALUES 
PREVIOUSLY  STORED  IN  COMMON. 

ITEMP  =  ARGUMENT,  SOURCE  CODE  ASSOCIATED  UITH  TEMPERATURE  TO 
BE  USED  IN  FUNCTION  CALCULATION 
NFTLO  =  FIELD  NUMBER  IN  STATE  FILE  FOR  LOWER  TEMPERATURE 
LIMIT  (USED  ONLY  IF  ISW=1> 

NFTUP  =  FIELD  NUMBER  IN  STATE  FILE  FOR  UPPER  TEMPERATURE 
LIMIT  (USED  ONLY  IF  ISW=1) 

TEMP  =  ARGUMENT,  TEMPERATURE  AT  WHICH  FUNCTION  IS  TO  BE 
COMPUTED 

COMMON  VARIABLES  USED  -  ILO, IMN, IT, IUP»LP»NPRRP,T , TLO, TUP 

SUBROUTINES  REQUIRED  -  FRCL, PAGER 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 

DATE  -  1  APRIL  1976 

COMMON/HEAD/DTE, LNCT,LNPG,LP,NPG,TITLE( 10) 

COMMON/IOCNT/ICVSL, IPRAC, IPRRP.NOFF ,NPRRP 
COMMON/TFUN/A,B,C,D, ILO, IMN, IT,IUP,T,TLO,TUP 


-—BRANCH  ON  ARGUMENT  CONTROL  SWITCH,  AND  RECALL  TEMPERATURE 
RANGE  FOR  FUNCTION  ON  FIRST  TIME  THROUGH.  NOTE  THAT  SOURCE 
CODES  ARE  SAVED  SEPARATELY  AND  ARE  ZERO  IF  AN  ERROR  OCCURRED. 
IF( ISW.EQ.2)  GO  TO  10 
IL0=7 

CALL  FRCL(NFTLO» TLO, ILO, IERR) 

IUP=7 

CALL  FRCL(NFTUP,TUP, IUP, IERR) 
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. STORE  REQUESTED  TEMPERATURE  FOR  FUNCTION  COMPUTATION 

10  T-TEMP 
IT=ITEMP 


. COMPARE  TEMPERATURE  TO  UPPER  BOUND.  SET  TO  LIMIT  IF  EXCEEDED 

AND  UPPER  BOUND  IS  GIVEN  WITH  HIGHER  SOURCE  CODE  THAN  DEFAULT. 
IF(T.LE.TUP)  GO  TO  40 
CALL  PAGER(3) 

HRITE(LPt 1000)  T.TLO.TUP 
IF(IUP.LE.l)  GO  TO  30 
T=TUP 

20  CALL  PAGER(2) 

WRITE(LP.IOIO) 


. ADJUST  SOURCE  CODE  OF  TEMPERATURE  WHEN  VALUE  HAS  BEEN  CHANGED. 

IF(IT.GT.2)  IT=2 
GO  TO  50 
30  CALL  PAGER<2> 

WRITE(LPf 1020) 

GO  TO  50 


. COMPARE  TEMPERATURE  TO  LOWER  BOUND.  SET  TO  LIMIT  IF  EXCEEDED 

AND  LOWER  BOUND  IS  GIVEN  WITH  HIGHER  SOURCE  CODE  THAN  DEFAULT. 
40  IF(T.GE.TLO)  GO  TO  50 
CALL  PAGER(3) 

WRITE(LP.IOOO)  T.TLO.TUP 
IF(ILO.LE.l)  GO  TO  30 
T=TLO 
GO  TO  20 


. -ASSIGN  FUNCTION  VALUE  SOURCE  CODE  TO  MINIMUM  SOURCE  CODE  OF 

VALUES  ON  RIGHT-HAND  SIDE  OF  EQUATION 
50  IF(IT.GT.IMN)  IT=IMN 


. DISPLAY  VALUE  OF  TEMPERATURE  USED  IN  COMPUTATION 

IF(NPRRP.EQ.O)  RETURN 
CALL  PAGER! 2) 

WRITE(LP*1030)  T 
RETURN 

10000F0RMAT  </  5X.40H*m*WARNING  -  REQUESTED  TEMPERATURE  OF  .G13.4/15X 
1.  20HIS  NOT  WITHIN  RANGE  .G13.4.4H  TO  .G13.4/) 

1010  FORMAT  <  10X.4AHC0MPUTATI0N  USES  TEMPERATURE  AT  LIMIT  OF  RANGE/) 
10200F0RMAT  (  10X.68H INSUFFICIENT  DATA  AVAILABLE  -  COMPUTATION  USES  REQ 
1UESTED  TEMPERATURE/) 

10300F0RMAT  (  10X.42HFUNCTI0N  VALUE  COMPUTED  AT  TEMPERATURE  OF  .G13.4. 

1  14H  DEG.  C  IS  .../) 

END 

LOGICAL  FUNCTION  COEF(NFA.NFB.NFC.NFD) 

FUNCTION  COEF  RETRIEVES  UP  TO  FOUR  TEMPERATURE  FUNC1I0N 
COEFFICIENTS  FROM  THE  DATA  BASE.  AND  RETURNS  A  LOGICAL  VALUE 
INDICATING  WHETHER  OR  NOT  THE  COMPUTATION  CAN  PROCEED.  THE 
ARGUMENTS  DEFINE  THE  FIELD  NUMBERS  FOR  THE  COEFFICIENTS  OR 
ARE  ZERO.  COEFFICIENTS*  FOR  NON-ZERO  FIELD  NUMBERS.  ARE 
RETRIEVED  AND  STORED  IN  A  TO  D,  IF  AN  ERROR  IS  ENCOUNTERED 
DURING  RECALL.  OR  IF  AT  LEAST  ONE  COEFFICIENT  DOES  NOT  HAVE 
A  HIGHER  SOURCE  CODE  THAN  A  DEFAULT  VALUE.  THE  FUNCTION  PRINTS 
A  MESSAGE  AND  RETURNS  A  VALUE  OF  .TRUE.  SO  THAT  FURTHER 
PROCESSING  MAY  BE  SKIPPED.  ON  RETURN.  COEF  IS  SET  .FALSE. 

IF  AT  LEAST  ONE  NON-DEFAULT  COEFFICIENT  WAS  FOUND.  HOWEVER. 

IMN  GIVES  THE  MINIMUM  SOURCE  CODE  FOR  ALL  COEFFICIENTS  AND 
IS  USED  TO  ASSIGN  A  SOURCE  CODE  TO  THE  COMPUTED  FUNCTION  VALUE. 
THIS  METHOD  PERMITS  THE  COMPUTATION  TO  PROCEED  FOR  DISPLAY 
PURPOSES  IF  COEFFICIENTS  ARE  PARTIALLY  SPECIFIED.  BUT 
SUPPRESSES  STORAGE  OF  THE  RESULTING  FUNCTION  VALUE  IN  THE 
STATE  FILE. 

COEF  =  FUNCTION  VALUE  RETURNED  .FALSE.  IF  RETRIEVED 
COEFFICIENTS  CAN  BE  USED  FOR  COMPUTATION  OF 
TEMPERATURE  FUNCTION  VALUE.  .TRUE.  OTHERWISE 
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IERR  =  DATABASE  RECALL  ERROR  INDICATOR  SET  TO  ONE  IF  AN 
ERROR  OCCURRED 

I MX  =  HIGHEST  SOURCE  CODE  FOR  COEFFICIENTS  REQUESTED 
ISRC  =  DUMMY  ARGUMENT  RETURNING  SOURCE  CODE  FOR  SINGLE 

FIELD  VALUE  RECALL  USED  TO  OBTAIN  MIN/MAX  SOURCE 
CODES  FOR  MULTIPLE  RECALLS 

NFA  =  FIELD  NUMBER  FOR  COEFFICIENT  TO  BE  STORED  AS  A 

NFB  =  FIELD  NUMBER  FOR  COEFFICIENT  TO  BE  STORED  AS  B 

NFC  *  FIELD  NUMBER  FOR  COEFFICIENT  TO  BE  STORED  AS  C 

NFD  *  FIELD  NUMBER  FOR  COEFFICIENT  TO  BE  STORED  AS  D 

COMMON  VARIABLES  USED  -  A.B.C.D, IMN, LP.NPRRP 

SUBROUTINES  REQUIRED  -  FRCL. PAGER 

AUTHOR  -  R.G.  POTTS.  ARTHUR  D.  LITTLE.  INC.. 

35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 

DATE  -  1  APRIL  1976 


COMMON/HEAD/DTE.LNCT .LNPG.LP.NPG. TITLE (10) 
COMMON/IOCNT/ICVSL, IPRAC , IPRRP.NOFF .NPRRP 
COMMON/TFUN/A.B.C.D, ILO.IMN.IT.IUP.T .TLO.TUP 


- INITIALIZE 

COEF=. FALSE. 
IERR=0 
IMN -7 
I NX=-1 


- RECALL  FIRST  COEFFICIENT  VALUE 

IF(NFA.LE.O)  GO  ID  20 
ISRC=7 

CALL  FRCL(NFA.A, ISRC. IERR) 
IF(ISRC.LT.IMN)  IHN=ISRC 
IF ( ISRC.GT .IMX)  1MX=ISRC 


. -RECALL  SECOND  COEFFICIENT  VALUE 

20  IF(NFB.LE.O)  GO  TO  30 
ISRC=7 

CALL  FRCL ( NFB, B, ISRC. IERR) 
IFUSRC.LT.IMN)  IMN=ISRC 
IF(ISRC.GT.IMX)  INX=ISRC 


- RECALL  THIRD  COEFFICIENT  VALUE 

30  IF(NFC.LE.O)  GO  TO  40 
ISRC=7 

CALL  FRCL(NFC,C, ISRC. IERR) 
IF(ISRC.LT.IMN)  IMN=ISRC 
IF ( ISRC.GT » IMX)  INX=ISRC 


. RECALL  FOURTH  COEFFICIENT  VALUE 

40  IF(NFD.LE.O)  GO  TO  50 
ISRC=7 

CALL  FRCL<NFD»D, ISRC, IERR) 

IF ( ISRC.LT , IMN)  INN=ISRC 
IF (ISRC.GT , IMX )  INX=ISRC 


. TEST  FOR  ERROR  CONDITIONS  OR  USE  OF  DEFAULT  VALUES. 

50  IF ( IERR. ME. 0)  GO  TO  60 
IF( INX.lE.l)  GO  TO  70 

tcnm* 


!»  NCCAU  OF  FIELD  VALUES 
**•*•<;• 

N» '  *  I  »  •  1  000 


nnn  on  0000000000000000000000000000000000000000 


C - ALL  COEFFICIENTS  EITHER  HISSING  OR  DEFAULT  VALUES 

70  IF(NPRRP.EQ.O)  GO  TO  90 
CALL  PAGER<2) 

WRITE(LP) 1010) 

C 

90  C0EF=.TRUE. 

RETURN 

C 

10000FORHAT  </  5X» A0H*****ERR0R  -  COHPUTATION  OF  FUNCTION  VALUE  UNABLE 
1T0  PROCEED/) 

1010  FORMAT  (  10Xf 33HTEMPERATURE  FUNCTION  IS  UNDEFINED/) 

END 

FUNCTION  ICOHP ( I C 0 H A » ICODB) 

FUNCTION  ICOHP  PERFORMS  A  COMPARISON  OF  TWO  CHEMICAL 
RECOGNITION  CODES,  ICODA  AND  ICODB,  AND  RETURNS  AN  INTEGER 
VALUE  AS  FOLLOWS  - 

ICOMP  =  -1  ,  ICODA  .LT.  ICODB 

ICOMP  =  0  ,  ICODA  ,EQ.  ICODB 

ICOMP  =  FI  ,  ICODA  .GT *  ICODB 


THE  COMPARISON  REFLECTS  THE  SEQUENCE  OF  INTERNAL  CHARACTER 
CODES  AND,  FOR  THREE  CHARACTER  NON-BLANK  COPES,  MILL  PROVIDE 
THE  DESIRED  ALPHABETIC  SEQUENCE.  THIS  ROUTINE  ASSUMES  THAT 
THE  CODES  ARE  STORED  IN  A3  FORMAT  -  THEREFORE  BY  DEFINITION 
A  BLANK  (INTERNAL  CODE  40)  IS  STORED  IN  THE  FOURTH  CHARACTER 
POSITION.  SINCE  THE  LAST  BIT  IS  ALWAYS  ZERO,  UORB  CONTENTS 
ARE  SHIFTED  ONE  BIT  POSITION  RIGHT,  THEN  MANIPULATED  TO  DROP 
THE  SIGN  BIT  WHICH  IS  PRESENT  FROM  J  TO  Z.  THE  FINAL 
COMPARISON  IS  MADE  ON  BIT  PATTERNS  EQUIVALENT  TO  THOSE  ON 
INPUT,  BUT  SHIFTED  BY  ONE  POSITION. 


ICODA  =  THREE  CHARACTER  RECOGNITION  CODE,  ARGUMENT 
ICODB  =  THREE  CHARACTER  RECOGNITION  CODE,  ARGUMENT 
ICOMP  =  INTEGER  FUNCTION  VALUE 

IXA  =  INTERNAL  VARIABLE  USED  FOR  MANIPULATION  OF  CONTENTS 
OF  ARGUMENT  ICODA 

IXB  =  INTERNAL  VARIABLE  USED  FOR  MANIPULATION  OF  CONTENTS 
OF  ARGUMENT  ICODB 

COMMON  VARIABLES  USED  -  NONE 

SUBROUTINES  REQUIRED  -  NONE 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC. 

35/309A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-844-5770  EXT,  2813 
DATE  -  27  SEPTEMBER  1975 


- COPY  RECOGNITION  CODES  INTO  INTERNAL  VARIABLES  FOR  MANIPULATION 

IXA1=IC0DA 

IX81*IC0PB 

- SHIFT  WORD  CONTENTS  TO  RIGHT  JUSTIFY. 

IXA=SHIFT ( IXA1 , 18) 

IX8*SHIFT ( IXB1 , 18) 


C 

C 

8 


-—VARIABLES  IXA  AND  IXB  NOW  CONTAIN  THE  SAME  BIT  PATTERN  AS  THE 
ARGUMENTS  ICODA  AND  ICODB,  RIGHT  JUSTIFIED,  AND  CAN  BE  COMPARED 
IF(IXA-IXB)  10,20,30 


RETURN  FOR  ICODA  .LT.  ICODB 
10  IC0MP--1 
RETURN 

RETURN  FOR  ICODA  ,EQ.  ICODB 
20  ICOMP=0 
RETURN 
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RETURN  FOR  ICODA  .GT.  ICODB 
30  IC0MP=+1 

RETURN 

END 

SUBROUTINE  PC0NV(NWTYP. NUVAL > 

SUBROUTINE  PCONV  PERFORMS  DATA  UNIT  CONVERSIONS  OF  PHYSICAL 
PROPERTY  DATA  READ  IN  SI  TO  COS  UNITS  FOR  HACS  COMPUTATIONS. 
THIS  ROUTINE!  PERFORMING  THE  LIMITED  CONVERSION  OF  SI  TO  CGS. 
HAS  ADAPTED  FROM  SUBROUTINE  OCONV  USED  FOR  GENERAL  PROPERTY 
FILE  OUTPUT  CONVERSIONS.  THE  ARRAY  OF  VALUES  ON  INPUT.  NUVAL > 
IS  REPLACED  BY  CONVERTED  VALUES  ON  RETURN.  FIELD  VALUES  HAVING 
A  TYPE  OF  MISSING  ARE  NOT  CONVERTED. 

CONVERSION  EQUATIONS  ARE  EVALUATED  IN  REVERSE  FIELD  SEQUENCE 
DUE  TO  DEPENDENCIES  AMONG  CONVERSION  EQUATIONS  FOR  TEMPERATURE 
FUNCTION  COEFFICIENTS.  WITHIN  THE  LOOP  ON  FIELD  NUMBER.  THE 
ACTUAL  CONVERSION  EQUATIONS  AND  FACTORS  TO  BE  APPLIED  ARE 
SELECTED  BY  BRANCHING  ON  THE  TYPE  OF  PHYSICAL  QUANTITY  STORED 
IN  THE  ARRAY  XTQN  AND  INDEXED  BY  FIELD  NUMBER. 

AB  =  TEMPERATURE  CONVERSION  FACTOR 

AG  s  SAME  AS  AG 

IFLD  =  INTEGER  INDEX  FOR  FIELD  NUMBER 

IX  *  INTEGER  VARIABLE  USED  FOR  INDEX  IFLD+1  IN  TEMPERATURE 
FUNCTION  COEFFICIENT  CONVERSIONS 
KTYP  =  INDEX  GIVING  TYPE  OF  QUANTITY  FOR  FIELD  IFLD  USED 
TO  REFERENCE  CONVERSION  DATA  ARRAYS  AND  CONTROL 
THE  SELECTION  OF  CONVERSION  EQUATIONS 
NHTYP  *  SOURCE  STATUS  CODES  FOR  FIELD  VALUES  READ  FROM 
PROPERTY  FILE  <0«MISSING.  2*ESTINATE.  3*EXACT) 

NUVAL  =  ARRAY  OF  PROPERTY  FILE  FIELD  VALUES 
TEMP  *  TEMPORARY  VARIABLE  FOR  PARTIRAL  SUM  OF  CONVERSION 
EQUATION  TERMS 

XCNV  a  ARRAY  OF  CONVERSION  FACTORS  USED  IN  SCALAR  PRODUCTS 
OR  CONVERSION  EQUATIONS  ACCORDING  TO  FIELD  NUMBER 
AND  TYPE  OF  PHYSICAL  QUANTITY. 

XTQN  =  INTEGER  ARRAY  GIVING  TYPE  OF  PHYSICAL  QUANTITY  FOR 
EACH  FIELD  (1  TO  74).  VALUES  SHOULD  NOT  BE 
INTERPRETED  TOO  RIGIDLY  BY  PHYSICAL  DEFINITION  AS 
SOME  DEGREE  OF  REDUNDANCY  MAY  BE  INTENTIONALLY 
INCLUDED  TO  SIMPLIFY  CONVERSION  PROCESSING. 


COMMON  VARIABLES  USED  -  NONE 
SUBROUTINES  REQUIRED  -  NONE 


AUTHOR  -  R.G.  POTTS.  ARTHUR  D.  LITTLE.  INC.. 

35/309A  ACORN  PARK. 
CAMBRIDGE.  MASS..  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  27  SEPTEMBER  1775 


DIMENSION  NUT YP ( 1 ) . NUVAL ( 1 ) » XCNVI 30 ) . XTQN( 74 ) 
INTEGER  XTQN 
REAL  NUVAL 

DATA  AB/273. 15/. AG/273. IV 


ODATA  (XCNV( I ) » I“1 .30 ) 


/0.0 

273.15 

-2.30259 

0.001 

4186.8 

0.01 


.1.0 

.1000. 

.418.68 

.1.0 

.4186.8 

.1.0 


.273.15 

>1000. 

.418.68 

.1.0 

.4186.8 

.1.0 


.0.1 

.1000. 

.4186.8 

.2.12483 

.4186.8 

.1.0 


.1000. 

.0.1 

.4186.8 

.4186.8 

.1.0 

.1.0 
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c 

ODATA  (XTQN(I)f 1=1,74) 

1  /  1 »  1 »  1.  2.  3,  3*  3f  4,  5.  6,  It  7.  8>  9t  At  6.10,  Atilt  3 

2  At  6,12,  Atl2tl3t  At  6,14,  6,14,15,  At  A, 16,  AtlAt  6,17,  A 

3  17t 18t 19t  At  At  At  At20t21t22t23t  3t  3t24t24t24t24t24t24t24 

4  25 f 25 1 26 1 27 1 27 1 28 1 29 1 29 1  It  At30t30t  At30/ 

C 

C 

C - INITIALIZE  LOOP  ON  PROPERTY  FIELDS.  SEQUENCE  IS  IN  REVERSE 

C  ORDER  TO  PERMIT  SEQUENTIAL  CONVERSION  OF  TEMPERATURE  FUNCTION 

C  COEFFICIENTS. 

IFLD-74 

C . RETURN  HERE  FOR  EACH  NEU  FIELD t  SKIP  CONVERSION  IF  FIELD 

C  VALUE  IS  MISSING. 

10  IF(NWTYP< IFLD) . EO.O)  00  TO  20 

C . -BRANCH  ON  TYPE  OF  QUANTITY  TO  CONVERSION  EQUATIONS  FOR 

C  EACH  FIELD. 

XTYP-XTQN(IFLD) 

OGO  T0(  20 t  20 t  300 t  400f  400t  AOOt  700t  800t  900.  400. 

1  1 100 t 1200 t 1300 t 1400. 1300 t  400.1700.1300.1100.2000. 

2  2100.2200.2300.  400.  20.  400.  20.  400.  400.  20).KTYP 

C 

C . -RETURN  HERE  FOLLOWING  CONVERSION  TO  PICK  UP  NEXT  FIELD. 

C  SKIP  ALHPANUMERIC  FIELDS  1.2*3 

20  IFLD-IFLD-1 

IF ( IFLD.GT .3)  GO  TO  10 
RETURN 
C 

C— . CONVERSION  EQUATIONS 

C 

C . — KTYP-1 1  FIELDS  1.2.3.11.69.  NO  CONVERSION  REQUIRED 

C  100  GO  TO  20 

C . -KTYP-2,  FIELD  4.  ALL  CONVERSION  FACTORS  ARE  UNITY 

C  200  GO  TO  20 

C - KTYP-3,  FIELDS  5.6.7.20.52.53 

300  IF ( IFLD.EQ.20)  GO  TO  320 

310  NWVAL ( IFLD) -NWVAL < IFLD) -XCNV< KTYP) 

320  GO  TO  20 

C - KTYP-4.  FIELD  8 

400  NUVAL ( IFLD) -NWVAL ( IFLD) /XCNV< KTYP ) 

GO  TO  20 

C . — KTYP-5,  FIELD  9 

C  500  GO  TO  400 

C - KTYP-A,  FIELDS  10. 15. 16. 18.21 .22. 24.27.28.30.33.34.36.38. 

C  40.44,45.46.47.70.73 

600  IF ( IFLD. EQ. 44)  GO  TO  320 
IFdFLD.NE.45)  GO  TO  310 
NWVAL ( 45 ) -AG+NWVAL ( 45 ) 

GO  TO  20 

C . KTYP-7,  FIELD  12 

700  TEMP-AG< ( NWVAL (13) - AGtNWVAL (14)) 

GO  TO  2340 

C . —KTYP-8,  FIELD  13 

800  TEMP-2. <AG<NWVAL< 14) 

GO  TO  2330 

C . — KTYP-9.  FIELD  14 

900  TEMP-0.0 
GO  TO  2320 

C . KTYP-10.  FIELD  17 

C1000  GO  TO  400 

A  c - KTYP-11,  FIELD  19 

1100  NWVAL(IFLD)-NWVAL( IFLD) -XCNV( KTYP) 

GO  TO  20 

C . KTYP-12.  FIELDS  23,25 

1200  IF(IFLD.EQ.23>  GO  TO  400 
1210  IX-IFLD+l 

TEMP«AG<NWVAL ( IX ) 

GO  TO  2340 

C . KTYP-13,  FIELD  26 

1300  TEMP-0.0 
GO  TO  2330 

C . KTYP-14,  FIELDS  29,31 
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1400  IF ( IFLO • EQ • 29 )  GO  TO  400 
GO  TO  1210 

C . KTYP=15.  FIELD  32 

C1500  GO  TO  1300 

C . KTYP*16»  FIELDS  35.37 

Cl 600  GO  TO  400 

C - KTYP»17.  FIELDS  39.41.  CONVERSION  FACTORS  FOR  FIELD  39  ARE  1.0 

1700  IFUFLD.EQ.41)  GO  TO  1210 
GO  TO  20 

C . KTYP*18»  FIELD  42 

C1800  GO  TO  1300 

C . KTYP*19»  FIELD  43 

C1900  GO  TO  1100 

C - KTYP-20.  FIELD  48 

2000  TEMP*ABt ( NWVAL ( 49 ) - AG* ( NUVAL ( 50  ) -ABBNWVAL ( 51 ) ) ) 

GO  TO  2340 

C - KTYP=21 .  FIELD  49 

2100  TEMP*ABt ( 2 . tNWVAL < 50 ) -3 . *AB*NWVAL ( 51 ) ) 

GO  TO  2330 

C . -KTYP=22.  FIELD  50 

2200  TEMP=3. *AB*NWVAL (51) 

GO  TO  2320 

C . KTYP=23»  FIELD  51 

2300  TEHP=0.0 
2320  CONTINUE 
2330  CONTINUE 

2340  NWVAL ( IFLD) =TEMP+NWVAL ( IFLD) /XCNV <  KT YP ) 

GO  TO  20 

C - KTYP-24.  FIELDS  54.55.56.57.58.59.60 

C2400  GO  TO  400 

C . KTYP-25.  FIELDS  61.62.  CONVERSION  FACTORS  ARE  UNITY. 

C2500  GO  TO  20 

C . KTYP-26.  FIELD  63 

C2600  GO  TO  400 

C - KTYP=27»  FIELDS  64.65.  NO  CONVERSION  REQUIRED 

C2700  GO  TO  20 

C - KTYP-28.  FIELD  66 

C2800  GO  TO  400 

C - KTYPe29 ,  FIELDS  67.68 

C2900  GO  TO  400 

C - KTYP*30»  FIELDS  71.72.74.  NO  CONVERSION  REQUIRED 

C3000  GO  TO  20 

C 

C 

END 

SUBROUTINE  PROP(INDXX) 

C 

C  SUBROUTINE  PROP  SEARCHES  THE  HACS  PHYSICAL  PROPERTY  DATA  FILE 

C  FOR  A  CONPOUND  HAVING  A  RECOGNITION  CODE  GIVEN  BY  ICD  AND 

C  RETRIEVES  PROPERTY  DATA  VALUES.  PROPERTY  VALUES  ARE  FIRST 

C  CONVERTED  FROM  SI  UNITS  TO  CGS  UNITS  AND  THEN  STORED  IN  THE 

C  HACS  STATE  FILE.  THE  ARRAY  FLDN  ESTABLISHES  THE  CORRESPONDENCE 

C  BETWEEN  PROPERTY  FILE  FIELD  NUMBERS  (1  TO  74)  AND  HACS  STATE 

C  FILE  FIELD  NUMBERS.  ONLY  EXACT  OR  ESTIMATED  PROPERTY  VALUES 

C  ARE  TRANSFERRED  TO  HACS.  AFTER  THE  TRANSFER.  FIELD  VALUES 

C  ARE  RECALLED  AND  USED  IN  THE  COMPUTATION  OF  TEMPERATURE 

C  FUNCTION  VALUES  AT  AMBIENT  AND  BOILING  POINT.  IF  THE  USER 

C  SPECIFIED  RECOGNITION  CODE  IS  GIVEN  INCORRECTLY  AND  THE 

C  CHEMICAL  IS  NOT  FOUND  ON  THE  FILE.  ERROR  MESSAGES  ARE  GIVEN 

C  AND  THE  OPERATION  FLAG  NOP  IS  SET  TO  ZERO  TO  FORCE  JOB 

C  TERMINATION  ON  RETURN. 

C 

C  FLDN  *  INTEGER  ARRAY  GIVING  FIELD  NUMBER  IN  HACS  STATE  FILE 

C  CORRESPONDING  TO  PROPERTY  FILE  ITEM  NUMBER  (1  TO  74) 

C  VALUE  IS  ZERO  IF  PROPERTY  ITEM  IS  NOT  TRANSFERRED 

C  TO  HACS. 

C  HDR  =  SIX-WORD  INTEGER  HEADER  ARRAY  APPEARING  AS  FIRST 

C  RECORD  ON  PROPERTY  FILE  GIVING  LABEL  AS  FOLLOWS  - 

C  WORD  1  ■  DATE  OF  RUN  CREATING  BACK-UF  FILE  IN 

C  16  FORMAT  AS  MMDDYY 

C  WORD  2  *  VERSION  NUMBER  OF  BACK-UP  FILE 

C  WORD  3  *  DATE  OF  UPDATE  RUN  CREATING  FILE  IN 
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16  FORMAT  AS  MMDDYY 

WORD  4  =  SEQUENTIAL  VERSION  NUMBER  (INCREMENTED 
BY  1  ON  EACH  UPDATE  CYCLE) 

WORD  5  =  TAPE  FILE  IDENTIFICATION  IN  A4  FORMAT 
WORD  6  =  IDENTIFICATION  OF  TAPE  FILE  USED  AS  INPUT 
TO  UPDATE  RUN  CREATING  CURRENT  FILE 
(BACK-UP  FILE  ID  IN  A4  FORMAT) 

I  =  FORTRAN  LOOP  INDEX 

IERR  =  ERROR  INDICATOR  SET  IN  HACS  STATE  FILE  RECALL 
OPERA  (ION.  USE  REPLACED  BY  SOURCE  CODE  OF  0 
ALSO  RETURNED  FOR  ERROR  CONDITION. 

ITAM  =  SOURCE  CODE  FOR  VALUE  OF  AMBIENT  TEMPERATURE  STORED 
IN  STUE  FILE 

ITBP  =  SOURCE  :ODE  FOR  VALUE  OF  BOILING  TEMPERATURE  STORED 
IN  SUTE  FILE 

ITP  =  FORTRAN  I/O  UNIT  REFERENCE  NUMBER  FOR  PHYSICAL 
DEVICE  ON  WHICH  PROPERTY  DATA  IS  STORED 
TAM  =  VALUE  OF  AMBIENT  TEMPERATURE  RECALLED  FROM  HACS  FILE 

TBP  =  VALUE  OF  BOILING  TEMPERATURE  RECALLED  FROM  HACS  FILE 

VAL  =  COMPUTED  VALUE  OF  ANY  FUNCTION  OF  TEMPERATURE 

YCOD  =  CHEMICAL  RECOGNITION  CODE  READ  FROM  PROPERTY  FILE» 

INTEGER  EQUIVALENCED  TO  YVAL(l) 

YNAM  =  COMPOUND  NAME  READ  FROM  PRCPERTY  FILE .  STORED  AS  SA8 

YPTH  *  ARRAY  OF  PATH  CODES  READ  FROM  PROPERTY  FILE.  STORED 

AS  UP  TO  15  A4  PATH  CODEi  IN  EIGHT  A8  DATA  WORDS  - 
LAST  PART  OF  LAST  DATA  WORD  IS  NOT  USED. 

YTYP  *  ARRAY  OF  STATUS  CODES  FOR  EACH  (1  TO  74)  PROPERTY 
FIELD  VALUE.  CODES  ARE  0  FOR  MISSINGf  2  FOR 
ESTIMATED  AND  3  FOR  EXACT  PROPERTY  VALUES. 

YVAL  «  REAL  ARRAY  FOR  PROPERTY  DATA  VALUES.  WORDS  2  AND  3. 
CORRESPONDING  TO  COMPOUND  NAME  AND  PATH  CODES. 
RESPECTIVELY!  ARE  NOT  USED. 

COMMON  VARIABLES  USED  -  A.B.C.D.ICD.1LO.IPRRP.IT.IUP.LP.NOP. 

NPRRP.T  > TLO. TUP 

SUBROUTINES  REQUIRED  -  BNDCK.COEF.EXP.FRCL.FSV.ICOMP.IFEOF. 

PAGER rPCONV 

AUTHOR  -  R.G.  POTTS.  ARTHUR  D.  LITTLE.  INC.. 

35/309A  ACORN  PARK. 

CAMBRIDGE.  MASS..  02140 
TEL.  617-864-5770  EXT.  2813 

DATE  -  6  APRIL  1976 


OCOMMON/CNTRL/EOFF  > ICD. IDFLT.LBL( 4) . LSTCN(3»3) . MODEL ( 15) .NOP* 


INTEGER 

REAL 


STCON.SVCON 

EOFF.STCON.SVCON 

LBL 


COMMON/HEAD/DTE  »LNCT .LNPB.LP.NPG. TITLE (10) 
COMMON/ IOCNT/ I CVSL . IPRAC. IPRRP . NOFF . NPRRP 
COMMON/ TFUN/A.B. C. D. ILO. IHN. IT » IUP.T. TLO. TUP 


TEMPERATURE  FUNCTION  COEFFICIENT  A 
TEMPERATURE  FUNCTION  COEFFICIENT  B 
TEMPERATURE  FUNCTION  COEFFICIENT  C 
TEMPERATURE  FUNCTION  COEFFICIENT  D 
LOWEST  SOURCE  CODE  FOUND  ON  RECALL  OF  COEFFICIENTS 
SOURCE  CODE  FOR  VALUE  OF  TLO  IN  STATE  FILE 
SOURCE  CODE  FOR  COMPUTED  FUNCTION  VALUE  OBTAINED  AS 
MINIMUM  SOURCE  CODE  OF  ALL  VALUES  ON  RIGHT  HAND 
SIDE  OF  EQUATION. 

SOURCE  CODE  FOR  VALUE  OF  TUP  IN  STATE  FILE 
VALUE  OF  TEMPERATURE  TO  BE  USED  IN  COMPUTING  FUNCTION 
VALUE.  OBTAINED  FROM  AMBIENT  AND  BOILING  TEMPERATURE 
ADJUSTED  IF  NECESSARY  TO  RANGE  OF  EQUATION 
LOWER  LIMIT  OF  TEMPERATURE  RANGE  FOR  WHICH  EQUATION 
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c 

c 

c 

c 

c 


HAS  BEEN  DEFINED 

TUP  =  UPPER  LIMIT  OF  TEMPERATURE  RANGE  FOR  WHICH  EQUATION 
HAS  BEEN  DEFINED 

COMMON/PXFER/BUFF?KtSNCOD 
INTEGER  SNCOD 

INTEGER  FLDN<74)?HDR(6)?YC0D?YTYP(74> 
fefSKsloN  ?N^fl(5)  ?YVAL(74)  ?FREF (84) 

INTEGER  OREC ( 84 ) ?  TCOD  <  5  >  ?  BUFF ( 1 5 ) ?  PTLST  <  29 )  ? SCOD » SCLST ( 28 ) 

©EQUIVALENCE  (OREC( 1 ) ? YCOD.FREF ( 1 ) ) ? (0REC<2) ?YNAM(1 ) ) ? 

1  ( OREC  <  7 ) ? MCOD ) ? ( OREC ( 8 ) ? SCOD  >  ? ( OREC ( 9 ) » TCOD  < 1 ) ) > 

2  (OREC (14) ?YVAL(4) ! ? (HDR(l) ?OREC(l) ) 

ODATA  (PTLST < I ) f 1  =  1 ? 29)/lHA? 1H8? 1HC? lHDf 1HE? 1HF  ? 1H6? 1HH? 1HI ? 1HJ* 

1  1HK? 1HL? 1HM? 1HN? lHOt 1HP ? 1HQ? 1HR? 1HS? 1HT ? 1HU? 1HV? 1HW? 1HX? 1HY? 

2  lHZf 2HII »2HRR» 2HSS/ 

ODATA  (SCLST <  I )  1 1  =  1 ? 28)/3HA  B?3HA  Cr5HA  B  Cf  5HA  D  E»7HA  D  F  fii 

1  9HA  D  E  F  G.3HA  H?5HA  I  J?  7HA  H  I  J.5HA  K  L?7HA  K  M  N? 

2  9HA  K  L  M  Nr 3HA  Of 3HA  Pr5HA  P  Qf 7HA  P  R  Sf 9HA  P  Q  R  St 

3  3HA  T f 5HA  T  UfSHA  V  U>9HA  T  U  V  U? 3HA  XiSHA  X  YflHZf2HIlf 

4  2HRRf 4HRR  Cf2HSS/ 


DATA  ITP/9/ 

ODATA  (FLDN( 1 ) i 1=1 »74 


1  /  Of  0.  Of 

2  Of 1038t 1039  f 

3  1047f 1048f 1049f 

4  1057? 1058? 1059? 

5  1028? 1029? 1010? 

6  1067fl068f 1069f 

7  2033f 1076f 101Sf 

8  1017fl018f 1019  f 


) 

1002  f 1003  f 
1040f 1041 f 
1050f 1051 f 

1060r 1008f 
1011 f 1 0 1 2  f 

1070t 1014f 
2032f 1 077 • 
1020/ 


1 033  f 
1 04  2  f 
1 052  f 

1061  f 
1 0  62  f 

1071  f 
1078f 


1025f 
1 043  f 
1053 1 
1031  f 
1063f 
1072f 
1 079  * 


1034f 
1044f 
1054  f 
1032f 
1064  f 
1073f 

1080  f 


1035t 

1045f 

1055f 

1026f 

1 065  f 
1074f 
Oi 


1036f 
1046  f 
1056? 
1027? 
1066? 
1075? 
1016? 


C 
C 
C 

INDXX*1 

C . —SET  UP  AUDIT  OPTION 

NPRRPaIPRRP 

C . -WRITE  STATUS  MESSAGE  TO  USER  OUTPUT 

IF(NPRRP.EQ.l)  CALL  PAGER(O) 

C  CALL  PAGER ( 1 ) 

C  WRITE(LP? 1000)  ICD 

C 

C . REWIND  TAPE  AND  READ  HEADER  RECORD.  TERMINATE  IF  GET  END  FILE. 

REWIND  ITP 

BUFFER  IN( ITP? 1 )  <HDR( 1 ) ?HDR<6) ) 

IF (UNIT ( ITP) )  30?5?5 

8 . INITIAL  END  OF  FILE  ERROR  CONDITION 

5  CALL  PAGER (2) 

WRITE(LPflOlO) 

C 

C . ERROR  RETURN 

10  NOP-O 
C 

C - NORMAL  RETURN 

20  CONTINUE 
REWIND  ITP 
C 

C . RESTORE  OUTPUT  AUDIT 

NPRRP*1 
RETURN 
30  CONTINUE 
C 

C . DISPLAY  FILE  HEADER 

C  30  CALL  PAGER(3) 

C  WRITE (LP? 1020)  HDR(5) ? HDR( 4) ? HDR(3) ?HDR(6) ? HDR(2) ?HDR( 1 > 

1 . RETURN  HERE  TO  READ  NEXT  PHYSICAL  PROPERTY  RECORD 

C 

C . TEST  FOR  END  OF  FILE.  GIVE  ERROR  MESSAGE  AND  RETURN  IF 
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c 

c- 


CHEHICAL  HAS  NOT  BEEN  FOUND, 

40  BUFFER  INdTP.l)  (ORECd  >  ,0REC<84>  > 
IFtUNIT ( ITP> )  50.41,41 

41  CALL  PAGER (2) 

WR1TECLP, 1030) 

42  INDXX=0 
GO  TO  20 


C 

C- 


. COMPARE  COMPOUND  RECOGNITION  CODE  DESIRED  TO  ONE  JUST  READ 

50  CONTINUE 

IF< IC0MP( YC0D.ICD) )  40,70,60 


. TAPE  HAS  BEEN  SEARCHED  PAST  POSITION  FOR  ICD. 

60  CALL  PAGER(3) 

URITE(LP, 1040) 

GO  TO  42 


PRINT  DATA 


. -PROPERTIES  OF  REQUESTED  COMPOUND  HAVE  BEEN  FOUND. 

FIELDS  WHICH  ARE  NOT  TRANSFERRED  TO  HACS. 

70  CALL  INIT(YTYP,30,5,2) 

DO  2000  1=1,74 

2000  YTYP< I )=ITST(TCOD» I ) 

K=LENGTHdTP)  +  l 
Kl=85 

DO  2020  J=4,74 
I*78-J 
K1*K1- 1 

IF(YTYPd)  ,EQ»0)  GO  TO  2010 

FREF(K1 )*FREF (K) 

GO  TO  2020 
2010  FREF(K1)*0.0 
2020  CONTINUE 

CALL  PAGER<4) 

WRITE (LP, 2030)  YCOD,  YNAM.YVALdl ) 

20300F0RMAT  (/5X.46HPHYS1CAL  PROPERTY  DATA  RETRIEVED  FOR  CHEMICAL  ,A3/ 
1  9X.7HNAME  *  .5A8/9X. 17HSHIPPING  STATE  *  ,A8) 

CALL  INIT ( ITMP.29, 1 , 1 ) 

K*0 

DO  2040  1=1,29 
ITMP=ITST(MCOD» I ) 

IF(ITNP.EQ.O)  60  TO  2040 
K-K41 

BUFF(K)=PTLST  <  I ) 

2040  CONTINUE 
SNCOD-SCOD 

IF (NPRRP.EQ.O)  GO  TO  71 
CALL  PA6ER<4> 

WRITE<LP, 1060) 

71  CONTINUE 


CONVERT  FIELD  VALUES  FROM  SI  UNITS  AS  READ  FROM  PROPERTY  FILE 
TO  COS  UNITS  FOR  INTERNAL  HACS  USE. 

“~ONV( YTYP,) 


CALL  PC 


rYVAL) 


. LOOP  THROUGH  FIELD  NUMBER  LIST  AND  TRANSFER  EXACT  OR  ESTIMATED 

VALUES  OF  UNIT  DATA  FIELDS  TO  HACS.  IF  FIELD  NUMBER  IS  ZERO, 
VALUE  IS  NOT  TRANSFERRED, 

DO  80  1-4,74 

IF(FLDNd).EQ.O)  GO  TO  80 
IF(YTYPd).EQ.O)  GO  TO  80 
CALL  FSV(FLDNd)  ,YVALd )  ,YTYPd  > ) 

80  CONTINUE 
GO  TO  20 


. COMPUTATION  OF  TEMPERATURE  FUNCTION  VALUES  AT  AMBIENT  AND 

BOILING  TEMPERATURE, 

IF(NPRRP.EQ.O)  GO  TO  81 
CALL  PAGER<0) 

CALL  PAGER(2) 

WRITE<LP» 1070) 

81  CONTINUE 
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- RECALL  VALUES  IN  STATE  FILE  AND  SAVE  SOURCE  CODES 

ITAM*7 

NXXX*NPRRP 

NPRRP-1 

CALL  FRCL(2004>TANf ITAHf IERR> 

NPRRP«=NXXX 

ITBP=7 

CALL  FRCL < FLDN <  5 ) f  TBP  f I TBP » I ERR ) 


C - COMPUTATION  OF  SATURATED  LIQUID  DENSITY. 

IF(NPRRP.EQ.O)  60  TO  82 
CALL  PAGER (2) 

WRITE(LP. 1080) 

82  CONTINUE 

IF(C0EF<FLDN(12)fFLDN<13)fFLDN(14>f0)>  GO  TO  90 
CALL  BNDCK(1fTAMfITAMfFLDN(H)fFLDN<15>) 
VAL=A+T*(B+T*C> 

CALL  FSV(1004»VAL»IT) 

CALL  BNDCK<2f TBPfITBPfOfO) 

VAL=A+T*(B+T*C> 

CALL  FSV<102I»VAL*IT) 

C 

C . COMPUTATION  OF  LIQUID  VISCOSITY. 

90  IF(NPRRP.EQ.O)  GO  TO  91 
CALL  PAGER(2) 

URITE(LPf 1090) 

91  CONTINUE 

IF(C0EF(FLDN(19) .FLIHH20)  iOf 0) )  GO  TO  100 
CALL  BNDCM 1 fTAMf ITAMfFLDN(22) f FLDN (21) ) 
VAL*EXP<A+B/(TE273.15) ) 

CALL  FSV(1004fVALfIT> 

CALL  BNDCK<2»TBP» ITBPiOfO) 

VAL*EXP(A+B/(Tt273« 15) ) 

CALL  FSV( 1005fVALf IT) 

C - COMPUTATION  OF  LIQUID  THERMAL  CONDUCTIVITY. 

100  IF(NPRRP.EO.O)  GO  TO  101 
CALL  PA6ER(2) 

HRITE(LPr 1100) 

101  CONTINUE 

IF<C0EF(FLDN(25) fFLDN(26) fOfO) )  GO  TO  110 
CALL  BNDCK ( 1 . TAM  > I TAM  >  FLDN ( 28 ) r  FLDN ( 27 ) ) 
VAL-AFBtT 

CALL  FSV(1081iVAL»Il ) 

CALL  BNDCK (2f TBPfITBPfOfO) 

VAL-A4BBT 

CALL  FS V ( 1 082  f  VAL  f I T ) 

C 

C . COMPUTATION  OF  LIOUID  HEAT  CAPACITY. 

110  IF (NPRRP.EQ.O)  GO  TO  111 
CALL  PAGER (2) 

HRITE(LPfIUO) 

111  CONTINUE 

IF(C0Er(FLDN<3i ) fFLDN(32) fOfO) )  60  TO  120 
CALL  BNDCK ( 1 f  T AM f I T AN f FLDN <  34 ) f FLDN ( 33 ) ) 
VAL«A4B*T 

CALL  FSV< 1007fVALf IT) 

CALL  BNDCK(2«T(PfITBPf0f0) 

VAL»A4B«T 

CALL  FSV(1083fVALfIT) 


-COMPUTATION  OF  SOLUBILITY.  NOTE  THAT  TEMPERATURE  BOUNDS  ARE 
PRE-SPECIFIED  AND  NOT  STORED  ON  THE  PROPERTY  FILE. 


120  IF(NPRRP.EQ.O)  GO  TO  121 
CALL  PAGER<2) 

URITE(LPf 1120) 

121  CONTINUE 

IF(C0EF(FLDN(41) fFLDN(42) fOfO) )  60  TO  130 

TLO-O.O 

IL0*3 

TUP«30.0 

IUP=3 
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CALL  BNDCK(2fTAHf ITAMf Of  0) 

VAL=A+B*T 

CALL  FSV(1084»VALf IT) 

CALL  BNDCK(2»TBPf ITBPf 0»0) 

VAL=A+B»T 

CALL  FSV(1085fVALf IT) 

C 

C . . COMPUTATION  OF  SATURATED  VAPOR  PRESSURE 

130  IF(NPRRP.EQ.O)  GO  TO  131 
CALL  PAGER<2) 

WRITE(LPf 1130) 

131  CONTINUE 

IF(COEF(FLDN(43)fFLDN(44)tFLDN(45)fO))  GO  TO  140 
CALL  BNDCK( If TANr ITAMf FLDN<47) f FLDN ( 46) ) 
VAL*10.0M<A-B/<T+C)) 

CALL  FSV<1086fVALf IT) 

CALL  BNDCK(2f TBPf ITBPf OfO) 

VAL=10.0M<A-B/(T+C>) 

CALL  FSV< 1087f VALt IT) 

C 

C - COMPUTATION  OF  VAPOR  HEAT  CAPACITY 

140  IF(NPRRP.EQ.O)  GO  TO  141 
CALL  PAGER! 2) 

MRITE(LPt 1140) 

141  CONTINUE 

IF<COEF(FLDN(48)fFLDN<49)fFLDN(50)fFLDN(51)))  GO  TO  20 
CALL  BNDCK ( 1 f  TAM  f I TAM  f  FLDN  <  53 ) » FLDN ( 52 ) ) 
VAL=A+T*<B+T*<C4T*D)) 

CALL  FSV(1013fVALf IT) 

CALL  BNDCK(2fTBPf ITBPf OfO) 

VAL=A+T*(B+T*(C+T*D>) 

CALL  FSV(10B8fVALf IT) 

GO  TO  20 


10000F0RMAT  <5Xf 65HSTARTING  SEARCH  OF  HACS  FILE  FOR  PHYSICAL  PROPERTIES 
1  OF  CHEMICAL  fA3f4H  ...) 

1010  FORMAT  (/5Xf46H*m*ERR0R  -  UNABLE  TO  READ  HACS  PROPERTY  FILE) 
10200F0RMAT  (/lOXf 21HFILE  OPENED  HAS  ID  =  .A4f20Hf  VERSION  NUMBER  =  f 
1  I5f lOHf  DATE  *  f I6/13Xf 18HBACK-UP  FILE  ID  =  ,A4f20Hf  VERSION  NU 
2HBER  *  f I5f lOHf  DATE  =  fI6) 

10300FORMAT  </5Xf 71H****tERR0R  -  UNABLE  TO  FIND  CHEMICAL.  SEARCH  TERMI 
1NATED  BY  END  OF  FILE) 

10400F0RMAT  ( /5Xf 56H*****ERR0R  -  UNABLE  TO  FIND  CHEMICAL.  SEARCH  TERMI 
INATED/lOXf 45HAFTER  PASSING  EXPECTED  ALPHABETICAL  POSITION.) 
10500F0RMAT  </5Xf 46HPHYSICAL  PROPERTY  DATA  RETRIEVED  FOR  CHEMICAL  fA3/ 

1  9Xt7HNANE  =  t 5A8/?Xf 13HPATH  CODES  *  t8A8/9Xt 17HSHIPPING  STATE  =  f 

2  A8) 

10600F0RMAT  </5Xf 46HTRANSF£R  OF  EXACT  OR  ESTIMATED  PROPERTY  VALUES/ 

1  5Xf 30HT0  HACS  STATE  FILE  FOLLOWS  .../) 

10700F0RMAT  (  5X 1 72HC0MPUT AT ION  OF  FUNCTIONS  OF  TEMPERATURE  FOLLOW  USIN 
1G  TEMPERATURES  OF  ,../> 

1080  FORMAT  (  5Xf43HC0MPUTATI0N  OF  SATURATED  LIQUID  DENSITY  .../ 

1090  FORMAT  (  5Xf 35HC0MPUTATI0N  OF  LIQUID  VISCOSITY  .../) 

1100  FORMAT  (  5X t 46HC0MPUT AT ION  OF  LIQUID  THERMAL  CONDUCTIVITY  .../) 

1110  FORMAT  (  5X f 39HC0MPUTATI0N  OF  LIQUID  HEAT  CAPACITY  .../) 

1120  FORMAT  (  5Xf 38HCOMPUTATION  OF  SOLUBILITY  IN  WATER  .../) 

1130  FORMAT  (  5X.43HC0MPUTATI0N  OF  SATURATED  VAPOR  PRESSURE  .../) 

1140  FORMAT  (  5X  f  38HC0MPUT  AT  ION  OF  VAPOR  HEAT  CAPACITY  .../) 

END 

SUBROUTINE  PTHCK(ULST > PTLST tMODNOf ISU ) 

SUBROUTINE  PATH  CHECK  COMPARES  THE  RATE  MODEL  LETTER  CODES 
GIVEN  AS  INPUT  (STORED  IN  ULST)  TO  THE  LIST  OF  VALID  CODES 
STORED  IN  THE  DATA  ARRAY  PTLST.  ON  RETURN f  THE  ARRAY  MODNO 
CONTAINS  INDEX  NUMBERS  FOR  EACH  INPUT  LETTER  AND  ISW  GIVES 
THE  STATUS  OF  THE  CHECKING  OPERATION  AS  FOLLOWS- 

ISW  *  0  NORMAL  RETURN 

ISW  *  1  THE  INPUT  LIST  CONTAINS  AN  UNRECOGNIZABLE  AND  NON¬ 
BLANK  RATE  MODEL  CODE.  THE  ARRAY  MODNO  IS  ONLY 
PARTIALLY  COMPLETED  ON  OUTPUT  AND  SHOULD  NOT  BE  USED 
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ISW  =  2 


MODEL  CODES  SPECIFIED  BY  USER  APPEAR  TO  BE  ALL 
BLANK*  OR  HAVE  HISSING  PATH  CODES  IN  LIST 


ISU  =  3  MODEL  CODES  SPECIFIED  BY  THE  USER  ARE  NOT  IN  THE 
PROPER  SEQUENCE  FOR  A  HAZARD  ASSESSMENT  PATH 
(EXCEPT  FOR  Of  Z*  II*  RR  AND  SS)  OR  AT  LEAST  ONE 
PATH  CODE  (INCLUDING  Of  Zf  II*  RR  AND  SS)  APPEARS 
MORE  THAN  ONCE. 

ISU  =  4  A  MODEL  CODE  IS  MISSING  IN  THE  LIST  GIVEN  BY  THE 
USER 

ON  RETURN  WITH  ISU  =  0*2*3  OR  4,  THE  ARRAY  MODNO  GIVES  THE 
INDEX  NUMBER  FOR  EACH  MODEL  SPECIFIED  IN  THE  USER  LIST.  IF 
ISU*2*  HACS  MAY  EITHER  TERMINATE*  OR  SELECT  DEFAULT  CODES 
FROM  THE  PROPERTY  FILE.  CASES  UITH  ISU=3  OR  4  MAY  BE  VALID* 
BUT  A  UARNING  MESSAGE  SHOULD  BE  DISPLAYED.  THE  PROPERTY  FILE 
UPDATE  PROGRAM  DOES  NOT  USE  THE  ARRAY  MODNO  AND  SHOULD  PRO¬ 
DUCE  A  FATAL  ERROR  ON  ALL  RETURNS  EXCEPT  ISU=0. 

PATH  CHECK  SEQUENCE  TESTS  ARE  SUPPRESSED  IN  THIS  VERSION  OF 
SUBROUTINE  PTHCK  FOR  RATE  MODELS  0*  Z*  II*  RR  AND  SS  WHICH 
MAY  APPEAR  AT  ANY  LOCATION  IN  THE  INPUT  LIST.  ADDITIONAL 
LOGIC  IS  INCLUDED  HOWEVER  TO  GENERATE  A  SEQUENCE  ERROR  IF 
ANY  OF  THESE  EXCEPTIONS  APPEARS  MORE  THAN  ONCE  IN  THE  INPUT 
LIST.  NOTE  THAT  THE  SEQUENCE  CHECK  APPLIED  TO  THE  REMAINING 
PATH  CODES  AUTOMATICALLY  SUPPRESSES  DUPLICATION. 

I  =  INTEGER  LOOP  INDEX 

ISU  =  ARGUMENT.  STATUS  INDICATOR  ON  RETURN  TO  CALLING 
ROUTINE 

J  =  INTEGER  LOOP  INDEX 

LAST  =  TEMPORARY  VARIABLE  USED  FOR  STORAGE  OF  PREVIOUS 
VALUE,  MODNO(I-l) 

MODNO  -  ARRAY  OF  NUMERIC  INDICES  CORRESPONDING  TO  USER 

SPECIFIED  RATE  MODEL  LETTERS  (1  TO  26  FOR  A  TO  Z, 
27*11 ,  28*RR*  29=SS  AND  30  FOR  BLANK) 

PTLST  *  ARGUMENT,  DATA  ARRAY  CONTAINING  ALL  VALID  RATE 

ULST  =  ARGUmInT^ARRAY’cONTAiSs  ^AfER86DEL'LET?ER^ASPECIFIED 
BY  USER  ON  INPUT. 

COMMON  VARIABLES  USED  -  NONE 

SUBROUTINES  REQUIRED  -  NONE 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D,  LITTLE*  INC.* 

35/309A  ACORN  PARK 
CAMBRIDGE*  MASS.*  02140 
TEL.  617-864-5770  EXT.  2813 

DATE  -  10  JULY  1975 


INTEGER  MODNO( 15) * PTLST ( 30 )* ULST (15) 


—  INITIALIZE  RETURN  STATUS  CODE*  AND  START  LOOP  ON  UORDS  IN  USER 
INPUT  LIST, 

ISU*0 

DO  20  1*1*15 

C  START  LOOP  ON  LIST  OF  VALID  MODEL  NAMES 

DO  10  J*1 *30 

IF (ULST ( I ) ,NE.PTLST( J) )  GO  TO  10 
C  GOT  A  MATCH.  STORE  AND  SKIP  UP  TO  OUTER  LOOP 

MODNO( I )*J 
GO  TO  ?0 
10  CONTINUE 

C  DID  NOT  FIND  A  MATCH.  RETURN. 

ISW*1 

RETURN 
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20  CONTINUE 


- CHECK  SEQUENCE  OF  PATH  CODES. 

MUST  APPEAR 

IF<M0DN0(1) .EQ.30)  GO  TO  60 
LAST=0 

DO  50  1=1 * 15 

IF<LAST. EQ.30)  GO  TO  30 

IF(MODNOd)  .GT.LAST)  GO  TO  40 


AT  LEAST  ONE  NON- BLANK  CODE 


. MODEL  CODE  OUT  OF  SEQUENCE. 

SET  ERROR  RETURN 
IF(MODNOd) .EQ.15)  GO  TO  24 
IF(M0DN0( I ) .EQ.26)  GO  TO  24 
IF(M0DN0(I ) .EQ.27)  GO  TO  24 
IF(N0DN0(I) . EQ.28)  GO  TO  24 
IF(MODNOd)  .EQ.29)  GO  TO  24 
22  ISW~3 
RETURN 


TEST  FOR  EXCEPTION!  OTHERWISE 


-CHECK  FOR  DUPLICATION  OF  PATH  CODES  WHICH  ARE  EXCEPTIONS  TO 
ASCENDING  SEQUENCE  RULE. 


24  DO  26  J=1*I 

IF(J.EQ.I)  GO  TO  50 
IF(M0DN0(  J) . EQ  .MODNOd ) )  GO  TO  22 
26  CONTINUE 
GO  TO  50 


30  IF(MODNOd).EQ.LAST)  GO  TO  50 
ISW=4 
RETURN 

40  LAST=MODNO(I ) 

50  CONTINUE 
RETURN 
60  ISU=2 
RETURN 
END 

SUBROUTINE  RNTIO 


THIS  ROUTINE  IS  CALLED  IMMEDIATELY  AFTER  A  USERS  BASIC  INPUT 
DATA  DECK  IS  READ  TO  SET  UP  OPTIONS  SELECTED  FOR  INPUT/OUTPUT 
CONTROL  DURING  AN  ASSESSMENT  RUN.  FIELD  VALUES  FROM  THE 
HACS  STATE  FILE  ARE  ACCESSED  AND  STORED  IN  COMMON  FOR  USE 
IN  EXECUTING  OR  SKIPPING  PORTIONS  OF  HACS  I/O  DURING  THE 
ASSESSMENT  RUN.  EACH  SET  OF  OPTIONS  REMAINS  IN  EFFECT  UNTIL 
THE  NEXT  SET  OF  USER  INPUT  CARDS  ARE  READ.  DIFFERENT  RUN 
SET  UPS  MAY  BE  USED  TO  SIMPLIFY  HACS  OPERATIONS  DEPENDING 
ON  THE  TYPE  OF  OPTIONS  TO  BE  SELECTED. 


IR 

IS 


=  ERROR  INDICATOR  FOR  DATA  BASE  RECALL*  NOT  USED 
=  SOURCE  CODE  TRACK  FOR  DATA  BASE  RECALL*  NOT  USED 


COMMON  VARIABLES  USED  -  ICVSL*IPRAC*IPRRP*LP*NOFF*NPRRP,UIND 
SUBROUTINES  REQUIRED  -  FRCL*IRCL*PAGER 


AUTHOR  -  R.G.  POTTS*  ARTHUR  D.  LITTLE*  INC.* 

35/309A  ACORN  PARK* 
CAMBRIDGE*  MASS.*  02140 
TEL.  617-864-5770  EXT.  2813 

DATE  -  17  MAY  1976 


COMMON/HEAD/DTE *LNCT*LNPG*LP*NPG*TITLE( 10) 
COMMON/ IOCNT/I CVSL  * IPRAC  * IPRRP  *  NOFF *  NPRRP 
COMMON/PLTCN/ANG* IBUF(4000) » IFRST , IPLT  *WIND 


-AUDIT  RUN  TIME  I/O  OPTIONS  SELECTED  BY  USER  OR  OBTAINED 
BY  DEFAULT 
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CALL  PAGER<3) 

NPRRP=1 

IR=0 

IS=£ 

WRITE <LP* 2010) 

2000  FORMAT  (40H  OUTPUT  OPTIONS  ARE  0=SUPPRESS*  1=SELECT) 

CALL  IRCL(3019*ICVSL*IS*IR) 

WRITE(LP*2000) 

CALL  IRCL(3002*N0FF *  IS* IR) 

IF<N0FF,NE.0>  CALL  FRCL(201&,WIND,IS*IR) 

WRITE(LP»2000) 

CALL  IRCL(3011*IPRAC,IS,IR) 

WRITE(LP,2000> 

20100F0RHAT (20H  OUTPUT  OPTIONS  ARE:/ 

1  22H  0  SELECT  ALL  UNITS/ 

2  22H  1  SELECT  CGS  UNITS/ 

3  21H  2  SELECT  SI  UNITS/ 

4  26H  3  SELECT  ENGLISH  UNITS/ 

5  24H  4  SELECT  MIXED  UNITS) 

CALL  IRCL (3018* IPRRP* IS» IR) 

RETURN 

C 

1000  FORMAT  </5X* 30H0UTPUT  CONTROL  OPTIONS  ARE  . .,/) 

END 

OVERLAY (3*0) 

PROGRAM  MODA 

MODA  OBTAINS  THE  NECESSARY  INFORMATION  FOR  THE  EXECUTION 
OF  SUBROUTINE  RLJVI.  RLJVI  COMPUTES  THE  FLOW  RATE 
FOR  EITHER  LIQUIDS  OR  GASES  AS  A  FUNCTION  OF  TIME 

COMMON/HEAD/DTE. LNCT.LNPG*LP*NPG, TITLE (10) 

COMMON/C/PLTYP*XBX( 150) 

INTEGER  PLTYP 

DIMENSION  TIMEA( 150) *  TEMP (150) *FRT ( 150) ,PTA( 150) *TMGS( 150) *TNLS( 15 
10) 

EQUIVALENCE  (XBX(l) *TIMEA<1) > 

DATA  M0P/4H  A  / 

CALL  TRACE(0,3.0) 

1  CONTINUE 
IERR=0 
ISC=6 

OBTAIN  FROM  DATA  BASE  THE  NECESSARY  DATA  ITEMS 

CALL  BEGPR(MOD) 

CALL  FRCL( 1002*AM* ISC* IERR) 

CALL  FRCL ( 1007 *CPL* ISC* IERR) 

CALL  FRCL(1010*AVP* ISC* IERR) 

CALL  FRCL (1011 *BVP* ISCiIERR) 

CALL  FRCL( 1012*CVP* ISC* IERR) 

CALL  FRCL( 1013* CPG* ISC > IERR) 

CPG*CPG/AM 

CALL  FRCL(  1014, HVAF’. ISC* IERR) 

CALL  FRCL (2001 , VOL* ISC* IERR > 

CALL  FRCL (2002*  HT*ISC,IERR) 

CALL  FRCL(2003*  HH*ISC*IERR) 

ISC1=8 

IER1=0 

CALL  FRCL (2004, TO* I3C1 , IER1 ) 

IF(IERl.EQ.l)  IERR=1 
IF(ISCl.LT.ISC)  ISC=ISC1 
ISC2-8 
IER2=0 

CALL  FRCL(2005,PT0* ISC2*IER2) 

IF < IER2.EQ. 1 )  IERR=1 

IF ( ISC2.LT • ISC)  ISC=ISC2 

IF<T0<GE<15< )  CALL  FRCL(1004*DL*ISC*IERR) 

IF (TO<LT , 15. )  CALL  FRCL< 1021 *DL, ISC, IERR) 

CALL  IRCL(2006* IADBT *  ISC* IERR) 

CALL  FRCL ( 2007 *AHSSO* ISC  * IERR) 
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CALL  FRCL( 2008, HOLED, I SC, I ERR) 

CALL  I RCL( 2009, INC, I SC, I ERR) 

CALL  IPCL(3001,ITAB,IS,IR) 

CALL  EPRNT (MOD, ISC, I ERR, I FLAG) 

IF(IFLAG.EQ.l)  GO  TO  ?9 
IF(IFLAG.EQ.2)  GO  TO  1 

IF  THE  INITIAL  PRESSURE  IN  THE  TANK  IS  GIVEN*  IT  MILL  BE  USED  TO 
FIND  THE  INITIAL  TEMPERATURE  OF  THE  CARGO,  IF  THE  TEMPERATURE  IS 
GIVEN  BUT  THE  PRESSURE  IS  NOT.  THE  TEMPERATURE  WILL  BE  USED.  IF 
BOTH  ARE  NOT  GIVEN.  THE  DEFAULT  VALUE  FOR  TEMPERATURE  HILL  BE  USED 
IF( ISC2.EQ ,5)  GO  TO  3 
PT0=-1. 

CALL  RLJVI 

3  CALL  RLJVKVOL.HT.HH.HOLED.DL.PTO.AM.IADBT .TO. AMSSO.CPG.CPL.HVAP. 
1AVP.BVP.CVP.INC. INS. TIMEA. TEMP. FRT.PTA.TMGS .TiiLS. TVL.TIMEG. TIMED 

CALCULATE  AVERAGE  RATES  OF  GAS  AND  LIQUID  RELEASE. 

GASRT =0 . 0 
RTLIQ=0.0 

IF (TIMEG.GT .0.0)  GASRT=TMGS(INS)/TIMEG 
IF ( TIMEL • 6T .0.0)  RTLIQ=TMLS ( INS > /TIMEL 

UPDATE  MTA  BASE  WITH  OUTPUT  OF  RLJVI 


CALL  OUTPR(MOD) 

CALL  PAGER<2) 

WRITE (LP. 10 ) 

CALL  F3V(4001 »TMGS< INS) 
CALL  FSV( 4047. GASRT .4) 
CALL  FSV(404B,TIMEG,4) 
AVTEM=  <  TEMP ( 1 ) +TEMP (INS 
CALL  FSV(40A8. AVTEM.2) 
CALL  PAGER(2) 
HRITE(LP.ll) 

CALL  FSV< 4002, TMLS< INS) 
CALL  FSV(4003»TVL»4) 
CALL  F3V(4049,RTLIQ,4) 
CALL  FSV(4050  >  TIMEL ,4 ) 
IF (TMLS ( INS) . LT . 1 . )  GO 
CALL  PAGER(2) 

WRITE(LP, 18) 

IF (TIMEL.LT .600. )  CALL 
IF (TIMEL , LT . 600 • )  CALL 
IF (TIMEL.LT .600. )  CALL 
IF(TIMEL.GE.600. )  CALL 
IF (TIMEL .GE . 600 . )  CALL 
IF(TIMEL.GE,600. )  CALL 
19  IF(TMGS< INS) .LT . 1 . )  GO 
CALL  PAGER (2) 

WRITE (LP. 20) 

IF (TIMEG.LT ,600, )  CALL 
IF(TIMEG.GE.600. )  CALL 
CALL  FSV(4044, GASRT,:, 
CALL  FSV(4045,TIMEG»2) 
21  CALL  ENDPR(MOD) 

IF(ITAB.EQ.O)  GO  TO  99 
DO  25  11=1,2 
CALL  PAGER(O) 

CALL  PAGER < 4 > 

WRITE(LP, 12 ) 

CALL  PAGER(l) 

WRITE (6, 13) 

IF(II.NE.l)  GO  TO  100 
CALL  PAGER(3) 
WRITE(LP,14) 

100  CONTINUE 

I F ( I 1 .NE.2)  GO  TO  110 
CALL  PAGER(3) 


,4) 

>  )/2. 

,4) 

TO  19 


ISV(2029,0,4> 
ISV(2058»0»4) 
ISV<2060,0»4> 
ISV ( 2029 ,1,4) 
I S V  <  2058 , 1 , 4 ) 
ISV (2060, 1,4) 
TO  21 


ISV(2061 ,0.2) 
ISV(2061 ,1,2) 
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WRITEiLPrlS) 

110  CONTINUE 

DO  16  1=1.  INC, 

IF(II.EQ.l)  FLW=FRT<D/1000. 

IF(II.EQ.l)  TMG=TMGS  D/1000. 

IF(II.EQ.l)  TML=TMLS( I)/‘.000. 

IF(II.EQ.l)  PRES=PTA(I>/1<  , 

IF ( II .EQ.2)  FLW=FRT < I >/454. 

IF(II.EQ.2)  TNG=TNGS( I)/454. 

IF ( II .EQ.2)  TNL=TMLS(I)/454. 

IF(II.EQ.2)  PRES=PTA< I >*0.0000145/77 
IF(II.EQ.l)  TEM=TEMP( I ) 

IF(II.EQ.2)  TEH=(1.8*TEMP< I) )+?:.. 

CALL  PAGER (1) 

URITE(LP,17)  TIMEA(I) .FLW  7MG.TML.TEM.PRES 

16  CONTINUE 
25  CONTINUE 

GO  TO  99 

10  FORMAT ( IX. 16HF0P  SAS  VENTING  /) 

11  FORMAT ( / 1 X ,  1 9Hr ;.p  LIQUID  VENTING  /) 

12  FORMAT ( 1H  •  75X » 44HTABLE  OF  CHEMICAL  VENTING  PROCESS  PARAMETERS// 
1) 

13  FORMAT ( 12X.11HTIME  OF  REL.5X.11HT0T  FLWRATE.5X, 11HT0T  GAS  REL.5X. 

' 11HT0T  LIQ  REL.6X.9HTANK  TEMP.7X.9HTANK  PRES) 

140F0RMAT  ( 15X.6H1 SECS) .9X .8H( KG/SEC ) . 10X. 4H(KG) . 12X.4H1KG) . 10X . 

1  7H(DEG  C).9X.8H(N/SCI  M) // ) 

150F0RMAT  ( 15X.6H(SECS) ,9X,8H(LB/S£C) . 10X»4H(LB) , 12X. ^ILB) . 10X, 

1  7HCDEG  F) »8X. 10H (LB/SQ  IN)//) 

17  FORMAT  <14X,F7.1,8X,G10.4,2(5X,G10.4>,7X,E7.1,7X,G10.4) 
180F0RMAT</1X.62HTHE  LIQUID  DISCHARGE  7 ATE  AND  DURATION  LEADS  TO  THE 

1ASSUMPTI0N/1X.61HTHAT  THE  FOLLOW!!  !•  SPILL  DURATION  INDICATORS  ARE 
2APPR0PRI ATE ♦ ) 

20  FORMAT (/1X.62HIN  CASE  MOT)"!.  C  DIRECTLY  FOLLOWS.  THE  VAPOR  DISCHARG 
*E  DURATI0N/1X.26S INDICATOR  IS  ESTIMATED  AS-) 

99  CONTINUE 

CALL  TRACED,  3,  C 
END 

FUNCTION  RLJI. £  AMASS. VOL. HT.HH.X.DL) 

THIS  FU*-:  'ION  CALCULATES  THE  LIQUID  LEVEL  ABOVE  THE  HOLE 

HIS  ROUTINE  IS  NOT  USED  SEPARATELY  AND  THEREFORE  REQUIRES  NO 
SPECIAL  INPUTS 

VOLL= ( t . -X) f AMASS/DL 
IF(VOLL-VOL*O.OOOD  10.5.5 
DZ=HT*VOLL/VOL-HH 
GO  TO  15 
>  DZ=- .01 

i  RLJLQ=DZ 

RETURN 
END 

SUBROUTINE  RLJTCt VOL.HT .HH.X.DL.DV.PT.PA. AN • AM. IADBT.T.AMASS.AMASO 
1  >  CPG  >  CPL .  HVAF'  >  AVP  >  B  VP » CVP ) 


THIS  SUBROUTINE.  CALLED  BY  THE  RENTING  RATE  INTEGRATION 
SUBROUTINE.  CALCULATES  INSTANTANEOUS  TANK  CONDITIONS 


C  THIS  ROUTINE  IS  NOT  USED  SEPARATELY  AND  THEREFORE  REQUIRES  NO 
C  SPECIAL  INPUTS 

C 

DATA  R/84836 .  '7469/ 

C . CHECK  WHEY  HER  ISOTHERMAL  OR  ADIABATIC 

IF (IADS  '1 5,5.25 

C . CAU  Jl.ATE  TANK  PRESSURE,  VAPOR  DENSITY,  AND  VAPOR  WEIGHT  FRACTION 

C . FOR  ISOTHERMAL  CASE 

5  PT=AMASS*R*T/(AM*VOL> 

PF=RLJVP(T .AVP.BVP.CVP) 

IF<PF,LT.PA)  F'F  =PA 
IF ( PT-PF) 10, 10,15 
DV=AM*PT/<R*T> 


10 


15 


L  *  * 

25 

27 


30 


X=l. 

GO  TO  55 
PT=PF 

BV=AM*PT/(R*T> 

X=(VOL*DV*DL/AMASS-DV)/<DL-DV> 

GO  TO  55 

...SEARCH  FOR  THE  TANK  TEHPERATURE 
TL=T 
TH=TL 
TL=TH-10, 

CALL  RLJTS(TL»TC»PC»XC»VOL»HT .HH.X.DL.DV.PT.PA.AK. AM.T .AMASS. AM ASO 
l.CPG.CPL.HVAP.AVP.BVP.CVP) 

IF(TL-TC>30»30.27 
DO  45  1=1 » 10 
TS=(TH+TL)/2. 

CALL  RLJTSITS.TC.PC.XC.VOL.HT .HH.X.DL.DV.PT .PA. AK. AM.T. AMASS.AMASO 
1 . CPG  » CPL . HVAP . AVP  f  BVP  » CVP ) 


35 

IFCTS-TC)40.50.35 

TH=TS 

40 

GO  TO  45 

TL=TS 

45 

CONTINUE 

50 

T  “ TS 

55 

r  i^PC 

•  xc 

RETURN 

EVD 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c.. 


c. 

5 


SUBROUTINE  RLJTS(TS»TC»PC»XC»VQL»HT .HH.X.DL.DV.PT.PA.AK. AM.T .AMASS 
1 » AM  ASO  » CPG  » CPL » HVAP  » AVP » BVP » CVP ) 

THIS  SUBROUTINE i  CALLED  BY  THE  TANK  CONDITION  SUBROUTINE'  USES  A 
PRESSURE-TEMPERATURE  RELATIONSHIP.  MASS  BALANCE.  AND  AN 
ENERGY  BALANCE  TO  CALCULATE  A  TEMPERATURE  FROM  THE  GIVEN  ONE. 
IF  THE  TWO  ARE  EQUAL  THEN  THE  TEMPERATURE  IS  THE 
SIMULTANEOUS  SOLUTION  TO  THE  FIXATIONS. 


THIS  ROUTINE  IS  NOT  USED  ££.• 
SPECIAL  INPUTS 


RATELY  AND  THEREFORE  REQUIRES  NO 


DATA  R/8483A. 73469/ 

...CHECKS  TO  SEE  IF  Ll'iJID  IS  PRESENT  IN  TANK 
PV*RLJVP(TS.AVP.’:  7-.CVP) 

PC=AMASS*R*T  ,'-M*VOL) 

IKPV-PCU:  .10.5 

. ..CALCULATE  TC  USING  IDEAL  GAS  EXPANSION  EQUATION 
■TT(PC/PT)I*( < AK-1 , )/AK) 

‘  AM*FC/(R*TS> 


10  25 

C...  ,'LCULATES  XC  AND  TC 

:  pc=pv 

DV=AM*PC/<R*TS) 

XC=(VOL*DV*DL/AMASS-DV)/<DL-DV> 

SH=AMASS*(X*CPG+(1.-X)*CPL) 

IF(RLJLQ< AMASS. VOL. HT.HH.X.DL) ) 20 » 15.15 
15  TC=T-<HVAP*(AMASS*XC-AMAS0*X)+V0L*(PT-PC>/42680. )/=H 
GO  TO  25 

20  TC=T-(HVAP*(AMASOt< 1. -X) -AMASS* ( l.-XC) )+VOLl :FT-PC)/42680. )/SH 
RETURN 
END 

SUBROUTINE  RLJVKVOL.HT. HH. HOLED. DL.F TO.AM. IADBT.TO.AMSSO.CPG. 
1CPL. HVAP. AVP.BVP. CVP .INC. INS. 7IMEA.TEMP.FRT.PTA.TMGS.TMLS.TVL. TIME 
2G. TIMED 

THIS  SUBROUTINE  INTtRATES  NUMERICALLY  THE  FLOW  RATE  AS  A 
FUNCTION  OF  TIME  AND  PRODUCES  ARRAYS  OF  THE  TIME. 

TEMPE-v- SURE.  INSTANTANEOUS  FLOW  RATE.  VAPOR  WEIGHT  FRACTION. 
AND  TANK  PRESSURE  AS  A  FUNCTION  OF  THE  MASS  FRACTION 
RELEASED. 


25 


C 

C 

C 

c 

c 


•:  n*t  inputs 
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or)  on  00000000000000000000  0000  0000000000  r 


VOL 

HT 

HH 

HOLED 

DL 

AH 

IADBT 

PTO 

TO 


AHSSO 

CPG 

CPL 

HVAP 

AVP*BVP 


INC 


VOLUME  OF  TANK  CM**3 

HEIGHT  OF  TANK  CH 

HEIGHT  OF  HOLE  CH 

DIAHETER  OF  THE  HOLE  CH 

LIQUID  DENSITY  GM/CMM3 

HOLECULAR  HEIGHT  OF  THE  CHEHICAL 
HEAT  TRANSFER  FLAG  (IF  POSITIVE*  TANK  IS  ADIABATIC* 
OTHERWISE  IT  IS  ISOTHERHAL 

INITIAL  TANK  PRESSURE  DYNES/CMM2. 

INITIAL  TEMPERATURE  OF  TANK  DEG  C 

N3TE-  THE  PROGRAH  DOES  NOT  REQUIRE  BOTH  THE  PRESSURE 
AND  TEHPERATURE  AS  INPUT.  IF  THE  PRESSURE  IS  GIVEN*  IT 
HILL  BE  USED.  IF  THE  TEMPERATURE  IS  GIVEN*  THE  INPUT 
FOR  PRESSURE  SHOULD  BE  SET  AT  SOME  NEGATIVE  VALUE. 

GMS 

CAL/GH-DEG  C 
CAL/GH-DEG  C 

_  CAL/GH 

rCVP-CONSTANTS  FOR  A  VAPOR  PRESSURE  EQUATION  WHICH  GIVES 
AN  ANSWER  IN  MM  HG.  THE  FORM  OF  THE  EQUATION  IS 
VAPOR  PRESSURES. **<AVP-(BVP/mCVP>)> 

WHERE  T  IS  THE  TEHPERATURE  IN  DEG  C 
NUHBER  OF  MASS  INCREMENTS  PROGRAH  IS  DESIRED  TO  RUN  FOR 
(MAXIMUM  ALLOWED  IS  150) 


INITIAL  HASS  IN  TANK 
HEAT  CAPACITY  OF  VAPOR 
HEAT  CAPACITY  OF  LIQUID 
HEAT  OF  VAPORIZATION 


***  OUTPUTS 

INS 

TIMEA 
TEHP 
FRT 
PTA 
THGS 
THLS 
TVL 
TIMEG 
TIMEL 


AN  INTEGER  INDICATING  THE  NUHBER  OF  HASS  INCREMENTS 
WHICH  WERE  RELEASED. 

ARRAY  OF  TIMES  SEC 

ARRAY  OF  TANK  TEMPERATURES  DEG  C 

ARRAY  OF  FLOW  RATES  DM/SEC 

ARRAY  OF  TANK  PRESSURES  DYNES/CHM2. 

ARRAY  OF  TOTAL  HASS  GAS  RELEASED  GH 

ARRAY  OF  TOTAL  MASS  LIQUID  RELEASED  GH 

VOLUME  OF  LIQUID  RELEASED  CHt*3 

TIME  OVER  WHICH  GAS  DISCHARGED  SECS 

TIME  OVER  WHICH  LIQUID  DISCHARGED  SECS 


ODIMENSION  TIMEA( 150) * TEMP (150) *FRT(150) *PTA ( 150 )* THLS (150) * 

1  TMGSU50) 

DATA  PA/1033.92857/ 

DATA  R/84836. 73469/ 

C  *t**  PA  IS  EQUAL  TO  ONE  STANDARD  ATMOSPHERE  IN  GHF/CMM2  UNITS. 

C  X*t  R  IS  THE  UNIVERSAL  GAS  CONSTANT  IN  GHF  CM/MOLE  DEG  K  UNITS. 

C . INITIALIZE 

PI=3» 14159265 
RP*1 .984 

AK*l./<l,-<RP/(AM*CPG)>) 

A-PI*( (HOLED/2. )*I2, ) 

TMG=0. 

TML=0, 

TIHEG=0.0 

7IMEL*0.0 

TVL-O. 

TINE*O,O00 

C0=.8 

PT*PT0/980.7 
IF(PT)  2*2*1 

1  TO* ( BVP/ ( AVP-AL0G10 ( 0 . 7356BPT ) ) ) -CVP+273 . 1 A 
T=TO 

T0=T-273. 16 
GO  TO  4 

2  T*T0+273.16 

PT  *RL  JVP  ( T  *  AVP » BVP  *  CVP ) 

4  BV«AH*PT/(R*T> 

IF<INC-150>5. 10*10 
5  INCC*INC 

GO  TO  15 
10  INCC*150 

15  AHAS*AMSSQ/FLOAT ( INCC ) 

AMASS-AHSSO 
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X= ( VOL*DV*DL/AMASS-DV )  / <  DL-DV ) 

CALL  VENTRtCO* AMASS *VOL*HT*HH*X*A*DL*DV*PT*PA*AK*AN.T*IFLAG*W) 

FR=U 

C . START  HASS  RELEASE  LOOP 

DO  20  INSxl*INCC 

C...,. CALCULATE  FLOW  RATE  AND  TANK  CONDITIONS 
AHAS0*AMASS 

IF(INS  .EQ.  INCC)AMAS=AMAS*.99 
AHASS=AHASS-AHAS 

CALL  RLJTC(V0L*HT *HH*X*DL*DV*PT  *PA* AK* AH* IADBT*T* AMASS* AMAS0*CPG* 
1CPL  * HVAP  * AVP  *  BVP * CVP  > 

CALL  VENTR ( CO *  AMASS* VOL* HT *HH*X*A*DL*DV*PT*PA* AK* AM*T» IFLAG*U) 
AVGFR=(W+FR)/2. 

IF(AVGFR.LE.O.O)  GO  TO  30 

DT=AMAS/AVGFR 

FR=U 

TIME=TIHE+DT 

C . CHECK  TO  SEE  IF  FLOW  HAS  STOPPED 

IF(PT-PA) 16* 18> 18 

16  AL=RLJLQ(AHASS*VOL»HT»HH*X*DL) 

IF (AL)30*30*17 

17  I F ( PT-PA+ AL* DL  >30*18*18 

C . SAVE  VALUES 

18  IF(1FLAG-1)30*40*50 
40  TML=THL+AMAS 
TIHEL=TIHEL+DT 
GO  TO  60 
50  THG*THG+AMAS 
T IHEG=TIHEG+DT 
60  TIHEA( INS)=TIHE 
TEHP( INS)=T-273. 16 
FRT ( INS)=FR 
PTA(INS)=PT*9B0.7 
TMGS( INS)=THG 
TMLS(INS)=THL 
20  CONTINUE 

INS  =  INCC 
GO  TO  31 
30  INS=INS-1 

31  TVL=TML/DL 
RETURN 
END 

FUNCTION  RL JVP ( T » AVP  *  BVP  *  CVP ) 

THIS  FUNCTION  CALCULATES  THE  VAPOR  PRESSURE  OF  THE 
HATERIAL  INSIDE  THE  TANK 

THIS  ROUTINE  IS  NOT  USED  SEPARATELY  AND  THEREFORE  REQUIRES  NO 
SPECIAL  INPUTS 

RLJVP=< 10»i*(AVP-(BVP/(T-273. 16+CVP) ) ) J/.7356 
RETURN 
END 

SUBROUTINE  VENTR<CO*AHASS*VOL*HT*HH*X*A*DL*DV*PT*PA*AK*AH*T*IFLAG* 
1U) 

THIS  ROUTINE*  CALLED  BY  THE  VENTING  RATE  INTEGRATION  SUBROUTINE* 
CALCULATES  INSTANTANEOUS  VENTING  RATES  (GH/SEC) 

THIS  ROUTINE  IS  NOT  USED  SEPARATELY  AND  THEREFORE  REQUIRES  NO 
SPECIAL  INPUTS 


DATA  R/84836. 73469/ 

DATA  G/980*/ 

C . CHECK  WHETHER  LIQUID  OR  GAS  IS  BEING  VENTED. 

DZ*RLJLQ(AHASS*VOL*HT  *HH*X*DL> 

IF(DZ)  10*10*5 

C . CALCULATE  LIQUID  VENTING  RATE 

C— CODE  REVISIONS  INSERTED  7  APRIL  1978 
5  ARG»2.tDLtG*(PT-PA+DL*DZ) 

CALL  SRTCK(ARG*1) 

W=CO*A*SQRT (AR6) 


oooonooonoooonnnnoonnonn  o  oooooo— c-  mw  mo 


IFLAG=1 

RETURN 

C . CHECK  UHETHER  GAS  FLOU  IS  CHOKED 

10  IF  (F'A/PT~(2  ./(AK+1 . )  )#*<  AK/(  AK-1 « )) >15* 15*20 

C . CALCULATE  THE  GAS  CHOKED  FLOW  VENTING  RATE 

15  ARG=AH*G/R 

CALL  SRTCK(ARG*2) 

ARGB=AK*<2./<AK+l.))*t<(AK+l.>/(AK-l.>) 

CALL  SRTCK( ARGB*3) 

ARGC=T 

CALL  SRTCK< ARGC*4) 

«=CO*SQRT(ARG)*SQRT<ARGB)*PT*A/SQRT(ARGC) 

IFLAG=2 

RETURN 

♦....CALCULATE  THE  GAS  NON-CH OKED  FLOU  VENTING  RATE 
0  B=PA/PT 

IF < B— 1 . )  21.22»22 

21  ARG=B**(2./AK)*AK/(AK-t.)*(l.-Btt((AK-l.)/AK))/(l.-B) 

CALL  SRTCK(ARGr5) 

ARGB=2,*G*(PT-PA)*DV 
CALL  SRTCK( ARGB r 6) 

W=C0*SQRT ( ARG ) XAXSQRT ( ARGB ) 

GO  TO  23 

2  W=0. 

3  IFLAG=2 
25  RETURN 

END 

SUBROUTINE  SRTCK(ARG.N) 

SPECIAL  SQUARE  ROOT  ARGUMENT  TEST  ROUTINE  INSERTED  BY 
R.G.  POTTS  ON  7  APRIL  1978.  IF  ARGUMENT  IS  LESS  THAN 
O.Of  THE  ROUTINE  GENERATES  A  WARNING  MESSAGE  THEN 
SUBSTITUTES  A  VALUE  OF  0.0  ON  RETURN.  THE  INTEGER 
N  IS  A  LOCATION  REFERENCE  TO  THE  CALLING  PROGRAM. 

REFERENCES  1  TO  6  ARE  USED  BY  SUBROUTINE  VENTR. 

CQMHON/HEAD/DTE*LNCT*LNPG*LP*NPG* TITLE (10) 

IF(ARG.GE.O.O)  RETURN 
CALL  PAGER(2) 

WRITE(LP.IOOO)  ARG*N 

ARG=0,0 
RETURN 

10000F0RMAT  <5X,38H*m*WARNING*  SQUARE  ROOT  ARGUMENT  OF  »G13.4/ 

1  10X*36H  WAS  SET  TO  0.0  AT  PROGRAM  LOCATION  *12) 

END 

OVERLAY (4»0) 

PROGRAM  QV4 

0V4  EXECUTES  THE  FOLLOWING  INTER-RELATED  GROUP  OF  FLAME  SIZE 
AND  THERMAL  RADIATION  RATE  MODELS  - 


RATE  MODEL  =  B 
E 
H 
L 
Q 
U 


INDEX  =  2 
5 
8 

12 

17 

21 


H  =  DUMMY  INTERNAL  VARIABLE  USED  TO  TRANSFER  VALUE  OF 
FIELD  4018  TO  FIELD  4006 
IR  =  ERROR  VALUE  RETURNED  BY  FRCL  ROUTINE 

IS  *  VALUE  OF  SOURCE  CODE  UPDATED  IN  FRCL*  NOT  USED  IN 

PROGRAM  0V4 

COMMON  VARIABLES  USED  -  MODNO 

SUBROUTINES  REQUIRED  -  FRCL  * FSV  * MODB 1 * H0DB2 * MODE 1 * M0DE2 * MODH » 

MODL  *  MODQ , MODU *  TRACE 

AUTHOR  -  R.G.  POTTSf  ARTHUR  D.  LITTLE*  INC.* 

35/309A  ACORN  PARK* 


s 


onnnnn  o  non  oo  oo  no  oo  oo  oo  onoo  nnonn 


CAMBRIDGE*  MASS .  *  02140 
TEL.  617-844-5770  EXT.  2813 
DATE  -  8  JANUARY  1976 

C0MN0N/0VCNT/M0DN0*0VLST(2?) *SGLST<29) 

INTEGER  OVLST* SGLST 

. PRINT  OVERLAY  EXECUTION  TRACE  MESSAGE*  THEN  BRANCH  ON  MODEL 

INDEX  NUMBER 
CALL  TRACE(0*4*0) 

. SELECT  MODEL  B 

IF(M0DN0.NE.2)  GO  TO  10 
CALL  M0DB1 
CALL  M0DB2 
GO  TO  100 

- SELECT  MODEL  E 

10  IF(MODNO.NE.S)  GO  TO  20 
CALL  M0DE1 
CALL  M0DE2 

CALL  FRCL(4018*H* IS*IR) 

CALL  FSV(4006*H*6) 

CALL  M0DB2 
GO  TO  100 

. -SELECT  MODEL  H 

20  IF (M0DN0.NE.8)  GO  TO  30 
CALL  M0DH 
GO  TO  100 

. SELECT  MODEL  L 

30  IF(M0DN0.NE.12)  GO  TO  40 
CALL  M0DL 
GO  TO  100 

. SELECT  MODEL  Q 

40  IF<M0DN0.NE.17)  GO  TO  50 
CALL  MODQ 
GO  TO  100 

. SELECT  MODEL  U 

50  IF(M0DN0.NE.21)  GO  TO  100 
CALL  MODU 

- PRINT  OVERLAY  EXECUTION  TRACE  MESSAGE*  THEN  RETURN  TO  MAIN 

HACS  CONTROL 
100  CALL  TRACE( 1*4*0) 

END 

FUNCTION  ARSIN(A) 

ARSIN  COMPUTES  THE  ARC  SINE  OF  AN  ANGLE  WHOSE  SINE  IS  GIVEN 
ARGUMENTS  — 

A  *  SINE  OF  THE  ANGLE 

ARSIN  *  THE  ANGLE  WHOSE  SINE  IS  A 

B*S0RT(1.-A»*2) 

IF (B.NE.O. >  GO  TO  1 
ARSIN=0. 

CALL  PAGER < 2) 

WRITE(6* 100) 

RETURN 

1  ARSIN*ATAN<A/B) 

RETURN 

100  FORMAT (23H  ERROR  IN  ARSIN  ROUTINE/) 

END 

SUBROUTINE  CVERT(D* I0UT) 

THIS  ROUTINE  CONVERTS  UNITS  OF  INPUT  AND  OUTPUT  DATA  TO  PROPER 


nnnnnnn  n  no  non  on  non noon  on  o 


UNITS  FOR  USE  BY  ROUTINE  PROTNK. 
***  INPUTS  AND  OUTPUTS  It* 

D 

I  OUT 


ARRAY  OF  INPUT  AND  OUTPUT  DATA  FROM  ROUTINE  PROTNK 
(  SEE  HEADING  OF  PROTNK  FOR  DEFINITIONS) 

INDICATOR  FLAG.  WHEN  I0UT=1»  OVERT  CONVERTS  DATA 
FROM  CGS  TO  ENG  UNITS,  WHEN  I0UT=2»  IT  CONVERTS 
FROM  ENG  UNITS  TO  CGS  UNITS. 


10 

20 


30 


DIMENSION  D(26).C<5> 

DIVISION  BY  C(l>  CONVERTS  UNITS  FROM  CM  TO  FEET 
C(1)=3Q,48 

DIVISION  BY  C(2)  CONVERTS  UNITS  FROM  CM  TO  INCHES 
C(2)*2.54 

DIVISION  BY  C(3)  CONVERTS  UNITS  FROM  DYNES/CMII2  TO  PSI 
C(3>*68975.72 

DIVISION  BY  C<4)  CONVERTS  UNITS  FROM  CAL/SEC-CM2  TO  BTU/HR-FT2 
C<4)=0. 0000753474 

DIVISION  BY  C(5)  CONVERTS  UNITS  FROM  CAL/SEC-CM-DEG  C  TO 
BTU/HR-FT-DEG  F 
C<5>=0. 004133? 

IF(IOUT.EQ.I)  GO  TO  5 
DO  3  1=1.5 
C(I)=1./C(I) 

D(1)=D(1>/C(1) 

D(2)=D(2)/C(2) 

D(4)=D(4)/C(3) 

D(5)=D(5)/C(4) 

DO  10  1=6.10 
D(I)=D(I)/C(5) 

DO  20  1=16.20 
D(I )=D(I)/C(3) 

IF(IOUT.EQ.I)  GO  TO  30 
D(22)=D(22)/C(3) 

D(23)=(D(23)-32.)*(5./9.) 

D(24)=D(24)/C(3) 

D(25)=<D(25)-32.)*(5./9.) 

D(26)=D(26)*60. 

RETURN 

END 

SUBROUTINE  FL JET (HOLED. XMOL.TADI A. ALPHA. AFR.XLEN.DE) 


III  THIS  ROUTINE  CALCULATES  THE  FLAME  LENGTH  AND  DIAMETER  (OF  AN 
EQUIVALENT  CYLINDRICAL  FLAME)  FOR  A  NON-PREMIXED  TURBULENT 
FLAME  BASED  ON  HOTTELS  ANALYSIS  OF  TURBULENT  FLAMES.  THE 
FLAME  PARAMETERS  ARE  FAIRLY  INSENSITIVE  TO  THE  PRESSURE  IN  THE 
TANK. 

********************************************************************* 
CC  ***********  INPUT  ARGUMENTS  **************** 


***  HOLED  DIAMETER  OF  HOLE  IN  THE  TANK  CMS 

***  XMOL  MOLECULAR  WEIGHT  OF  FUEL  GMS/MOL 

***  TADIA  ADIABATIC  FLAME  TEMPERATURE  DEG  C 

***  ALPHA  MOLAR  RATIO  OF  REACTANTS  TO  PRODUCTS 
***  AFR  STOICHIOMETRIC  AIR  FUEL  RATIO  GM  OF  AIR/GM  OF  FUEL 
FOR  STOICHIOMETRIC  COMBUSTION 
************  OUT  PUT  ARGUMENTS  ************ 

***  XLEN  LENGTH  OF  FLAME  CMS 

***  DE  DIAMETER  OF  EQUIVALENT  CYLINDRICAL  CMS 

FLAME  (FOR  USE  IN  THERMAL  RADIATION  MODELS). 
TF=TADIA+273. 

CT=l./(l.+AFR*XM0L/28.9) 

RHS= (5.3/CT )*SQRT ( (CTf ( 1 ,-CT)*2B,9/XM0L)*(TF/( ALPHA*300. ) ) ) 

***  300  DEG  KELVIN  IS  USED  FOR  AMBIENT  TEMPERATURE. 

***  SEMI  ANGLE  OF  JET  IS  ASSUMED  TO  BE  5.4  DEGREES. 

XLEN=HOLED*RHS 

DE=H0LED+XLEN/10.6 

RETURN 

FND 

SUBROUTINE  FLMAN(D.PG.UW. ALPHA) 
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c*********************************************************************** 


c 
c 
c 

c ***** 

C  D 
C  PG 
C  UU 
C 

cm*** 

c 
c 


THIS  SUBROUTINE  CALCULATES  THE  FLAHE  ANGLE  WITH  THE  VERTICAL 
USING  THE  HODEL  OF  SLIEPCEVICH.  WELKER*  HUFFMAN.  AND  PIPKIN. 


INPUT  ARGUMENTS  ***« 

POOL  DIAMETER  CMS 

FUEL  VAPOR  DENSITY  AT  THE  TEMP  OF  LIQUID. 
WIND  VELOCITY 

Ittt  OUTPUT  ARGUMENT  ***** 

ALPHA  FLAME  ANGLE  WITH  RESPECT  TO  THE  VERTICAL 


GM/CM**3 

CM/SEC 


RADIANS 


C*********************************************************************** 

C 

ALPHA=0 . 

IF(UU.LE.O. )  RETURN 

TC=3.3*( (D*UW/0. 15)**0.07)*( (UW**2/(980.*D) )**0.8>*( (PG/1 .2E-3)** 
l<-0.6) ) 


C 

C 

C 

C 

C 

C 

C 

C 

C 

c 


*** 

*** 


0.15  IS  THE  KINEMATIC  VISCOSITY  OF  AIR  IN  CM**2/SEC 
1.2E-3  IS  THE  DENSITY  OF  AIR  IN  GM/CM**3 
ALPHAsARSIN( (-1 ,+SQRT  < 1 . +4.*TC**2) )/(2.*TC)) 

RETURN 

END 

SUBROUTINE  FLMHT (DIA.D.R.H) 

THIS  ROUTINE  CALCULATES  THE  FLAME  HEIGHT  (CM)  OF  A  POOL  FIRE 
USING  THOMAS=S  MODEL. 


ARGUMENTS 

D1A 

D 

R 

H 


POOL  DIAMETER.CM 

DENSITY  OF  LIQUID  FUEL.  GM/CU  CM 
THE  BURNING  RATE  IN  CM/SEC 
FLAME  HEIGHT. CM 


H=DIA*42.*(R*D/(i .2E~3*SQRT< 980. tDIA >>)**. 61 
RETURN 
END 

SUBROUTINE  JHHRF(DIA. H.S. ALPHA. T.HF) 

C 
C 
C 
C 
C 

c 

C  ****  INPUT  ARGUEMENTS 

T  FLAME  TEMPERATURE. DEGREES  C 

DIA  DIAMETER  OF  THE  BURNING  POOL. CM 

H  HEIGHT  OF  THE  FLAME. CM 

S  DISTANCE  OF  THE  OBSERVER  FROM  CENTER  OF  BASE  OF  FLAHE. CM 

ALPHA  ANGLE  OF  PLUME  FROM  VERTICAL. RADIANS 


THIS  ROUTINE  CALCULATES  THE  MAXIMUM  RADIATION  FLUX  POSSIBLE  FROM 
A  FLAME  OF  GIVEN  CHARACTERISTICS  AT  A  GIVEN  DISTANCE  FROM  THE 
CENTER  OF  THE  BASE  OF  THE  FLAME 
SOLAR  INSULATI0N=300  BTU/HR-SQ  FT. 


***  OUTPUT  ARGUEMENTS 

HF  RADIATION  FLUX.CAL/SEC-SQ  CM 

PIa3. 14159265 
S*S/<2. 54*12.) 

ST=T 

H*H/<2. 54*12.) 

T=460,+<(9./5.)*T)+32. 

B:A=DIA/<2. 54*12.) 

SB* . 1713E-08 
EM=1 . 

TR*1 . 

EMPWRaSB*TR*EM* (T**4 . ) 

CALL  SVEIW( ALPHA. H.S. DIA. FMAX) 

HFa ( FMAX*EMPWR  >  f  300 . 
HFaHF*(252./(3600. *144, *2. 54*2.54)) 

T  *ST 

DIAaDIA* (2.54*12. > 

SaS*<2. 54*12.) 
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H=H*2. 54*12. 

RETURN 

END 

SUBROUTINE  MQDB1 

SUBROUTINE  M0DB1  IS  A  HODULE  OF  MODEL  B.  IT  OBTAINS  THE  NECESSARY 
DATA  TO  CALL  ROUTINE  FLJET ,  THE  ROUTINE  WHICH  COMPUTES  THE  FLAME 
LENGTH  AND  EQUIVALENT  DIAMETER  WHEN  A  GAS  VENTING  FROM  A  TANK  IS 
IGNITED  AT  ITS  SOURCE 
DATA  M0D/4H  B1  / 

1  CONTINUE 
IR=0 
IS=6 

OBTAIN  NECESSARY  DATA  ITEMS 


CALL  BEGPR 
CALL  FRCL ( 
CALL  FRCL( 
CALL  FRCL( 
CALL  FRCL( 
CALL  FRCL( 
CALL  EPRNT 
IFdL.EG.l 
IF (IL .EQ.2 


(MOD) 

2008,HOLED»IS»IR) 
1002»XMOL » IS, IR) 

1016,  TADIA, ISi IR) 

1017,  ALPHA. IS. IR) 

1018,  AFR, IS. IR> 
(MOD, IS, IR, IL) 

)  GO  TO  99 
)  GO  TO  1 


CALL  FLJET  AND  UPDATE  DATA  BASE  WITH  OUTPUT  FROM  FLJET 

CALL  FLJET(HOLED,XMOL,TADIA, ALPHA, AFR, XLEN,DE) 

CALL  OUTPR(MOD) 

CALL  FSV(4006,XLEN,4) 

CALL  FSV(4007,DE,4) 

AUDIT 

CALL  ENDPR(MOD) 

99  RETURN 
END 

SUBROUTINE  M0DB2 

SUBROUTINE  M0DB2  IS  PART  OF  MODELS  B  AND  E,  IT  CALCULATES  SAFE 
SEPARATION  DISTANCES  FROM  FLAMES  AND  THE  RADIATION  FLUX  VS 
DISTANCE  FROM  THE  FLAME  USING  SUBROUTINE  JHHRF 

COMMON/C/PLTYP , XBX( 150) 

INTEGER  PLTYP 

DIMENSION  AS(20),AH(20),SAFSP(4),HTFLX(4),ASAV(20) 

DIMENSION  PTITL(6),XTITL(6),XTITL1(6),YTITL(6) 

EQUIVALENCE  (XBX141 ) , AS< 1 ) ) ,  (XBX< 1 ) , AH ( 1 ) ) 

EQUIVALENCE  (XBX(21 ) , ASAV(1 ) ) , (XBX(61 ) ,SAFSP(1) ) 

ODATA  (PTITL  ( I ) , I =1 ,6) /BHRADIATIO, 8HN  FLUX  V,8HS  DISTAN, 

18HCE  -  M0D.8HEL  B  ,1H  / 

ODATA  (XTITL  ( I ) , I  =  1 , 6 ) /8HDI ST ANCE , 8H  FROM  FL.8HAME  CENT, 

13HER. . . . . ,  ,8H . . . 

ODATA  (XTITL1(I),I=1 , 6) /8HDISTANCE.8H  FROM  FL, SHAME  CENT, 

18HER . ,8H . ,8H. .  (FEET)/ 

ODATA  ( YTITL  ( I ) , 1=1 ,6)/8HRADIATI0,8HN  FLUX  ,BH  (CAL/CM, 

18H2-S)  , 1H  , 1H  / 

DATA  M0D/4H  B2  / 

DATA  HTFLX (1),HTFLX( 2 ) ,HTFLX(3)/0.753,0. 113,0.0339/ 

100  CONTINUE 
IR=0 
IS=6 
LP  =  6 

OBTAIN  NECESSARY  DATA  ITEMS  FOR  JHHRF 

CALL  BEGPR(MOD) 

CALL  IRCL(2082» ITKHT , IS, IR) 

IF(ITKHT.GT.O)  CALL  FRCL(2083,TKDIS,IS,IR) 

CALL  FRCL< 1019, T , IS, IR) 


nnno  oooo  ooo  nnnnnn 


CALL  FRCL ( 4006 *  H » IS  * IR ) 

CALL  FRCL(4007»DIA*IS» IR) 

CALL  FRCL (4008* ALPHA i ISf IR) 

IF < ITKHT.EQ. 1 )  GO  TO  101 
IERR=0 

CALL  FRCL(2010»HTFLX(4) »ISi IR) 

IF<HTFLX(4> .GT. 0.0. AND. HTFLX(4).LE. 0.0226)  IERR*1 
CALL  IRCL(3003»IB2SF,IS»IR) 

101  CONTINUE 

CALL  EPRNT (M0D» ISf IRf IL) 

IF(IL.EQ.l)  GO  TO  99 
IF (IL.EQ.2)  GO  TO  100 
IF (DIA.LE.0.0)  CALL  PAGER<4) 

IF(DIA.LE.O.O)  WRITE(LPf96) 

IF (DIA.LE.0.0)  GO  TO  99 
IF ( ITKHT.EQ. 1 )  GO  TO  97 

ITERATION  TO  FIND  SAFE  SEPARATION  DISTANCES 

SAFE  SEPARATION  DISTANCES  CALCULATED  ARE  ONLY  ACCURATE  TO 

WITHIN  10  FEET. 

THE  HINIHUH  DISTANCE  WHICH  CAN  BE  AN  OUTPUT  IS  5  FEET. 

SAFSPC4)=0.0 

DISNN=DIA/2. 

IF(IERR.EQ.l)  HTFLX(4)=0.0 
DO  50  ITER=1,4 
S=DISMN+< 10. t2. 54*12. ) 

ISTP=0 

IF (HTFLX( ITER )  .EQ .0.0)  GO  TO  50 
15  CALL  JHHRFIDIAfHfSf ALPHAfTfHF) 

IF(HF-HTFLX< ITER) )  20f25f30 
20  S=S-(10.*2.54*12.) 

IF(S.LE.DISMN)  S=DISHN+<5.*2.54*12. ) 

ISTPsl 

IF(S.EQ.(DISHN+(5.*2.54*12.)))G0  TO  25 
GO  TO  15 

25  SAF SP ( ITER ) =S-DISNN 
GO  TO  50 

30  IF ( ISTP.EQ. 1 )  GO  TO  25 
S=S+(100,*12.*2.54) 

GO  TO  15 
50  CONTINUE 

UPDATE  DATA  BASE  WITH  OUTPUT  FROM  JHHRF 
CALL  OUTPR(MOD) 

SAFE  SEPARATION  DISTANCES  ARE  MEASURED  FRON  THE  EDGE  OF 
THE  FLAME. 

CALL  FSV(4009fSAFSP(l)r4) 

CALL  FSV(4015»SAFSP(2).4) 

CALL  FSV<4017rSAFSP<3)>4) 

IF(SAFSP(4) . NE.O.O)  CALL  FSV(4034»SAFSP(4) » 4) 

CALL  PAGER (2) 

WRITEILPf 51 ) 

IF ( IERR.NE •  1 )  GO  TO  55 
CALL  PAGER (2) 

WRITEI6.40) 

55  CONTINUE 

CALL  ENDPR(NOD) 

IF ( IB2SF.NE » 1 )  GO  TO  1 

CALL  JHHRF  TO  OBTAIN  RADIATION  FLUX  AS  A  FUNCTION  OF 
REQUESTED  DISTANCE 


SMX*DISMNFSAFSP<3) 

SMN*DISMN+SAFSP< 1 ) 

AX=(SMX-SMN)/19. 

AS< 1 )»SMN 

CALL  JHHRF (DIA»HfAS(l)> ALPHA » T > AH ( 1 ) ) 
DO  10  I*2f20 


100 


onnnn 


, — — , 


AS  C I  )=AS< 1-1 ) FAX 

CALL  JHHRF(DIA>H> AS( I ) » ALPHA>T . AH( I ) ) 

WRITE  PLOT  FILE  INFORMATION 
10  CONTINUE 
DO  35  1=1 >20 
35  ASAV(I)=ASa>/100. 

DIV=1 ./3.281 

CALL  PLTLP(PTITL> ASAV>AH>20>XTITL> YTITL> 1 >DIV>XTITL1 ) 


. -SET  UP  OFF-LINE  PLOT 

PLTYP=2 

1  CONTINUE 

IF ( ITKHT .EQ.O)  60  TO  99 

97  CALL  JHHRF(DIA>H>TKDIS>ALPHA>T>RDFLX) 

CALL  PADER<5) 

WRITE(6>98) 

CALL  FSV(2066>RDFLX>4) 

CALL  M0DB3 
99  RETURN 

400F0RMAT  </lX>61HTHE  USER  GIVEN  RADIATION  FLUX  IS  LESS  THAN  THAT  FRO 
IN  THE  SUN./1X.51HTHE  MODEL  IS  THEREFORE  NOT  EXECUTED  FOR  THIS  VALU 
2E  • ) 

Sl^FORMAT (5Xj A7H***  SAFE  SEPARATION  DISTANCES  ARE  MEASURED  FR0M/9X»27 
1HTHE  OUTER  EDGE  OF  THE  FLAME) 

960F0RMAT(/5X»74H*m  MODEL  CANNOT  BE  EXECUTED  FOR  A  ZERO  OR  NEGATIVE 
1  POOL  DIAMETER.  *m/5X.34H*m  EXECUTION  IS  TERMINATED.  ****/) 

98  FORMAT (/61H  EXECUTION  OF  THE  COMPRESSED  LIQUEFIED  GAS  TANK  HEATING 
1  M0DEL/62H  HAS  BEEN  REQUESTED.  THE  FOLLOWING  OBTAINS  THE  NECESSAR 
2Y  DATA/25H  AND  EXECUTES  TNIS  MODEL./) 

END 

SUBROUTINE  MCDB3 

THIS  SUBROUTINE  OBTAINS  THE  DATA  NECESSARY  FOR  AND  EXECUTES  THE 
COMPRESSED  LIQUEFIED  GAS  TANK  HEATING  MODEL.  INPUTS  AND  OUTPUTS 
ARE  DESCRIBED  IN  THE  HEADING  FOR  SUBROUTINE  PROTNK. 

DIMENSION  D<26) 

DATA  H0D/4H  B3  / 

1  CONTINUE 

l.P=6 

CALL  BEGPR(MOD) 

TS=6 

1R=0 

CALL  FRCL(1010>AVP>IS>IR) 

CALL  FRCL(1011.BVF>IS>IR) 

CALL  FRCL(1012>CVP>IS>IR) 

DO  10  1=1 >20 
11=1+2061 

10  CALL  FRCUII>DU)»IS>IR) 

CALL  EPRNT (MOD> ISi IR> IL) 

IF (IL.EQ.l)  GO  TO  99 
IF ( IL.EQ.2)  GO  TO  1 
CALL  PROTNK(D>AVP>BVP>CVP) 

1 1 =D (21 ) 

CALL  CUTPR(MOD) 

IF ( II ,NE . 1 )  GO  TO  5 
CALL  PAGER! 3) 

WRITE(LP>  40) 

CALL  FSVI4051 >D(22) >4) 

CALL  FSV(4052>D(23) >4) 

5  IF ( II ,NE<2)  GO  TO  & 

CALL  PAGERI3) 

WRITE(LP>30) 

CALL  FSV(4053*D(24) * 4 ) 

CALL  FSV<4054tD<25)»4> 

6  IF( II.NE.3)  GO  TO  7 
CALL  PAGER (3) 

WRITE(LP»20> 

7  IF ( II  .EQ . 1 .OR , II .EQ .2 )  CALL  FSV(4055>B<26) >4) 

CALL  ENDPRIMOD) 
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99  RETURN 

20  FORMAT (/39H  ***  FAILURE  OF  TANK  DOES  NOT  OCCUR  ***/) 

30  FORMAT </49H  ***  FAILURE  OF  TANK  OCCURS  AT  INSIDE  OF  MALL  ***/> 

40  FORMAT ( /50H  ***  FAILURE  OF  TANK  OCCURS  AT  OUTSIDE  OF  MALL  ***/> 

END 

SUBROUTINE  M0DE1 

SUBROUTINE  M0DE1  IS  PART  OF  MODEL  E.  IT  OBTAINS  THE  NECESSARY 
DATA  TO  EXECUTE  FLMHT  t  WHICH  CALCULATES  FLAME  HEIGHT  OF  A 
POOL  FIRE 
DATA  MOD/4H  El  / 

1  CONTINUE 
IR=0 
IS=6 

OBTAIN  DATA 

CALL  BEGPR(MOD) 

CALL  FRCL(4007fDIA*IS»IR) 

CALL  FRCL< 1021 » D» IS. IR ) 

CALL  FRCL(1015fR»ISf IR) 

CALL  EPRNT (MOD. IS»IR»IL) 

IF(IL.EQ.l)  GO  TO  99 
IF ( IL .EQ. 2 )  GO  TO  1 

CALL  FLMHT.  THEN  UPDATE  DATA  BASE. 

CALL  FLMHT (DIA»D»R»H) 

CALL  OUTPR(MOD) 

CALL  FSV<401BrH*4) 

CALL  ENDPR(MOD) 

9?  RETURN 
END 

SUBROUTINE  M0DE2 


OBTAINS  THE  NECESSARY 
THE  FLAME  ANGLE 


SUBROUTINE  M0DE2  IS  PART  OF  MODEL  E.  IT 
DATA  TO  EXECUTE  FLMANf  WHICH  CALCULATES 
FROM  THE  VERTICAL 
DATA  M0D/4H  E2  / 

1  CONTINUE 
IR=0 

OBTAIN  DATA 

CALL  BEGPR(MOD) 

IS=6 

CALL  FRCL(4007»D.IS»IR) 

CALL  FRCL(2016iUW» IS» IR) 

CALL  FRCL( 1002» AM» ISi IR) 

CALL  FRCLC 1003»TB» IS» IR) 

CALL  EPRNT (MOD » IS » IR* IL ) 

IF ( IL.EQ. 1 >  GO  TO  99 
IF ( IL .EQ .2)  GO  TO  1 
CALL  COMPG(AM.TB.PG) 

CALL  FSV(1009»PGf4> 

CALL  FRCL(1009*PG.IS»IR) 

CALL  FLMAN  AND  THEN  UPDATE  DATA  BASE 

CALL  FLMAN <  D  >  PG  f  UW » ALPHA ) 

CALL  OUTPR (MOD) 

CALL  FSV ( 400B  r  ALPHA » 4 ) 

CALL  ENDPR(MOD) 

99  RETURN 
END 

SUBROUTINE  MODH 

SUBROUTINE  MODH  CALLS  THE  THERMAL  RADIATION  ROUTINES  OF  MODEL  E 
FOR  SPILLS  OF  HEAVIER-THAN-WATER»  FLAMMABLE  OR  COMBUSTIBLE 
LIQUIDS  WHICH  HAVE  A  BOILING  POINT  LESS  THAN  AMBIENT  TEMPERATURE. 
IN  DOING  S0>  IT  ESTIMATES  THE  DIAMETER  OF  THE  BASE  OF  THE  FLAME 
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AND  TRANSFERS  THE  VALUE  FOR  THE  HEIGHT  OF  THE  FLAME  (COMPUTED 
IN  M0DE1 )  FROM  FIELD  NUMBER  4018  TO  4006. 


CALL  PAGER(2) 

WRITEU.IOO) 

CALL  FRCL  <4003. VOL. IS. IR) 

D=2.*V0L**(l./3.) 

CALL  PAGER (2) 

URITE(6» 102) 

CALL  FSV(4007.D»4) 

CALL  M0DE1 
CALL  M0DE2 

CALL  FRCL(4018.H»IS.IR) 

CALL  FSV(4006»H.6) 

CALL  M0DB2 
CALL  PAGER(2) 

WRITE (6. 101 ) 

RETURN 

100  FORMAT (82H  MODEL  H  WILL  BE  REPLACED  BY  THE  EXECUTION  OF  E1.E2.  AND 
1B2  -  EXECUTION  PROCEEDING./) 

101  FORMAT ( 18H  MODEL  H  EXECUTED./) 

102  FORMAT (123H  MODEL  H  ASSUMES  THAT  THE  DIAMETER  OF  THE  FLAME  IS  TWIC 
*E  THE  VOLUME  OF  THE  LIQUID  DISCHARGED  TO  THE  1/3  POWER.  THEREFORE. 
*../) 

END 

SUBROUTINE  MODL 


SUBROUTINE  MODL  CALLS  THE  THERMAL  RADIATION  ESTIMATION  ROUTINES 
OF  MODEL  E  FOR  SPILLS  OF  SOLUBLE.  FLAMMABLE  OR  COMBUSTIBLE  LIQUIDS 
WHICH  HAVE  A  BOILING  POINT  LESS  THAN  THE  AMBIENT.  IN  DOING  SO. 

IT  ESTIMATES  THE  DIAMETER  OF  THE  BASE  OF  THE  FLAME  AND 
TRANSFERS  THE  VALUE  FOR  THE  HEIGHT  OF  THE  FLAME  (COMPUTED  IN 
M0DE1 )  FROM  FIELD  NUMBER  4018  TO  4006. 


CALI  PAGER<2) 

URITE(6» 100 ) 

CALL  FRCL ( 1021 .DENL. IS* IR) 

CALL  FRCL(2021.H.IS. IR) 

CALL  FRCL (4003* VOL* IS.IR) 

D=2.*V0L**0. 333333 

IF < H ♦ L T .304.8. AND. DENL.LT .1.0)  D=24.*V0L**0. 333333 
CALL  PAGER (2 ) 

URITEU.102) 

CALL  FSV(4007»D.2) 

CALL  M0DE1 
CALL  M0DE2 

CALL  FRCL(4018.H. IS.IR) 

CALL  FSV(4006.H»6) 

CALL  M0DB2 
CALL  PAGER(2) 

WRITE(6.101) 

RETURN 

100  FORMAT (85H  MODEL  L  IS  REPLACED  BY  THE  EXECUTION  OF  MODELS  E1.E2.  A 
1ND  B2  -  EXECUTION  PROCEEDING./) 

101  FORMAT ( 18H  MODEL  L  EXECUTED./) 

102  F0RMAT(5X*55HM0DEL  L  ESTIMATES  THE  BURNING  POOL  DIAMETER  AS  BEING. 

1../) 

END 

SUBROUTINE  MODQ 


SUBROUTINE  MODQ  CALLS  THE  THERMAL  RADIATION  ESTIMATION  ROUTINES 
OF  MODEL  E  FOR  SPILLS  OF  SOLUBLE. FLAMMABLE  OR  COMBUSTIBLE  LIQUIDS. 
IN  DOING  SO.  IT  ESTIMATES  THE  DIAMETER  OF  THE  BASE  OF  FLAME 
AND  TRANSFERS  THE  VALUE  FOR  THE  HEIGHT  OF  THE  FLAME  (COMPUTED 
IN  M0DE1)  FROM  FIELD  NUMBER  4018  TO  4006. 


CALL  PAGER( 2) 

WRITE (6.100) 

CALL  FRCL<4003. VOL. IS.IR) 
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D=2.*V0L**(l,/3.) 

CALL  PAGER(3) 

WRITE(6.102> 

CALL  FSV(4007.D»4) 

CALL  M0DE1 
CALL  M0DE2 

CALL  FRCL(4018»H»IS»IR) 

CALL  FSV(4006.H»4) 

CALL  M0DB2 
CALL  PAGER<2) 

WRITE (6. 101 ) 

RETURN 

100  FORMAT (85H  MODEL  Q  IS  REPLACED  BY  THE  EXECUTION  OF  MODELS  E1.E2.  A 
1ND  B2  -  EXECUTION  PROCEEDING./) 

101  FORMAT  ( 18H  MODEL  Q  EXECUTED./) 

102  F0RMAT(67H  MODEL  Q  ASSUMES  THAT  THE  DIAMETER  OF  THE  FLAME  IS  TWICE 
*  THE  VOLUME/  56H  OF  THE  LIQUID  DISCHARGED  TO  THE  1/3  POWER.  THEREF 
•ORE. . •/) 

END 

SUBROUTINE  MODU 

SUBROUTINE  MODU  CALLS  THE  THERMAL  RADIATION  ESTIMATION  ROUTINES 
OF  MODEL  E  FOR  SPILLS  OF  LIGHTER-THAN-UATER.  INSOLUBLE.  FLAMMABLE 
OR  COMBUSTIBLE  LIQUIDS.  IN  DOING  SO.  IT  TRANSFERS  THE  VALUE  FOR 
THE  HEIGHT  OF  THE  FLAME  (COMPUTED  IN  M0DE1)  FROM  FIELD  NUMBER 
4018  TO  4006.  THE  POOL  SIZE  USED  IS  THAT  COMPUTED  IN  MODT. 


CALL  PAGER(2) 

UR1TE<6» ICO) 

CALL  MO DEI 
CALL  M0DE2 

CALL  FRCLC4018.H.IS.IR) 

CALL  FSV(4006»H,6) 

CALL  M0DB2 
CALL  PAGERJ2) 

WRITE (6. 101 ) 

RETURN 

100  FORMAT (77H  MODEL  U  IS  REPLACED  BY  EXECUTING  MODELS  E1.E2  AND  B2  - 
1EXECUTI0N  PROCEEDING./) 

101  FORMAT ( 18H  MODEL  U  EXECUTED./) 

END 

SUBROUTINE  PROTNK(D.AVP.BVP.CVP) 

x£m**x**mmm*tmtt**mmm**m*mm*t*mmm**mm 

SUBROUTINE  PROTNK  EVALUATES  THE  RESPONSE  OF  THE  WALL  OF  A  CARGO 
TANK  CONTAINING  A  COMPRESSED  LIQUEFIED  GAS  (  NOT  ONE  WHICH  HAS 
BEEN  LIQUEFIED  BY  REFRIGERATION)  WHEN  SUBJECTED  TO  HEATING  BY 
AN  EXTERNAL  FIRE,  OUTPUT  INCLUDES  THE  TIME  TO  RUPTURE.  MECHANICAL 
STRESS  IN  THE  WALL  AT  THE  TIME  OF  RUPTURE.  AND  THE  WALL 
TEMPERATURE.  NOTE-  THE  ROUTINE  REQUIRES  DETAILED  SPECIFICATION 
OF  THE  PHYSICAL  PROPERTIES  OF  THE  WALL.  DEFAULT  VALUES  CONTAINED 
IN  HACS  ARE  TYPICAL  OF  THOSE  FOR  A  PROPYLENE  CARGO  TANK. 


***  INPUTS  *** 

D < 1 )  INTERNAL  TANK  DIAMETER  CM 

D(2)  WALL  THICKNESS  CM 

D<3)  FRACTION  OF  TANK  VOLUME  CONTAINING  VAPOR  NON-DIM 

IK 4)  RELIEF  VALVE  SETTING  (GAUGE  PRESSURE)  DYNES/CM2 

D(5)  HEAT  FLUX  AT  OUTSIDE  SURFACE  OF  TANK  CAL/CM2-SEC 

D(6)  WALL  THERMAL  CONDUCTIVITY  AT  0  DEG  F  CAL/CM-S-DEG  C 

D( 7)  WALL  THERMAL  CONDUCTIVITY  AT  400  DEG  F  CAL/CM-S-DEG  C 

D(8)  WALL  THERMAL  CONDUCTIVITY  AT  800  DEG  F  CAL/CM-S-DEG  C 

D(9)  WALL  THERMAL  CONDUCTIVITY  AT  1200  DEG  F  CAL/CM-S-DEG  C 

D( 10)  WALL  THERMAL  CONDUCTIVITY  AT  1600  DEG  F  CAL/CM-S-DEG  C 

D(ll)  SPECIFIC  HEAT  OF  WALL  AT  0  DEG  F  CAL/GM-DEG  C 

D( 12)  SPECIFIC  HEAT  OF  WALL  AT  400  DEG  F  CAL/GM-DEG  C 

D( 13)  SPECIFIC  HEAT  OF  WALL  AT  800  DEG  F  CAL/GM-DEG  C 

IK  14)  SPECIFIC  HEAT  OF  WALL  AT  1200  DEG  F  CAL/GM-DEG  C 

D< 15)  SPECIFIC  HEAT  OF  WALL  AT  1600  DEG  F  CAL/GM-DEG  C 

D( 16)  ULTIMATE  TENSILE  STRENGTH  OF  WALL  AT  0  DEG  F  DYNES/CM2 

007)  ULTIMATE  TENSILE  STRENGTH  OF  WALL  AT  400  DEG  F  DYNES/CM2 
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D(18)  ULTIMATE  TENSILE  STRENGTH  3F  WALL  AT  800  DEB  F  DYME8/CM2 

D(  19)  ULTIMATE  TENSILE  STRENGTH  OF  WALL  AT  1200  DEB  F  DYNES/CM2 

D(20)  ULTIMATE  TENSILE  STRLNGTH  OF  WALL  AT  1300  DEG  F-DYNES/CM2 

AVP.  BVP.  AND  CVP  ARE  CORRELATION  CONSTANTS  FOR  THE  VAPOR 

PRESSURE  EQUATION  WHICH  GIVES  AN  ANSWER  IN  UNITS 
OF  MM  HG. 

***  OUTPUTS  *** 

D ( 2 1 )  FAILURE  PARAMETER  FLAG.  DC21>=1.0  MEANS  FAILURE  OCCURS 

AT  OUTSIDE  OF  UALLf  =2.0  MEANS  ITS  AT  INSIDE  OF  WALL. 

=3.0  MEANS  THAT  FAILURE  DOES  NOT  OCCUR-THE  TANK  WALL  CAN 
WITHSTAND  STRESSES  AND  IS  IN  A  STEADY-STATE  CONDITION. 
D(22)  FAILURE  STRESS  AT  OUTSIDE  OF  WALL  DYNES/CM2 

D(23)  TEMPERATURE  AT  OUTSIDE  OF  WALL  DEG  C 

D<24 )  FAILURE  STRESS  AT  INSIDE  OF  WALL  DYNES/CM2 

D ( 25 )  TEMPERATURE  AT  INSIDE  OF  WALL  DEG  C 

IH23)  IF  D(22)=l .0  OR  2.0.  THIS  GIVES  THE  ELAPSED  TIME 
FROM  START  OF  FIRE  UNTIL  FAILURE  OCCURS  SECS 


REAL  L1.L2.L3.L4.L5.K12.K23.K1 .K2.K3.MCV1 .HCV2.L6 
DIMENSION  XC25).D(26) 

DATA  PI. SBC/3. 1415927.. 1713E-B/ 

DATA  DT/1 .363637E-3/ 

IQ=5 

10UT=1 

CALL  CVERT(D.IOUT) 

DO  8  IXD=t .4 
9  X< IXO)=D( IXD) 

Q=D(5) 

DO  9  IXD=6.20 
9  X ( IXD-1 )=D( IXD) 

10  10  1XD=21 .26 
DUXD)=0. 

10  X ( IXD-1 ) =0 • 

CALCULATE  SATURATION  TEMPERATURE  AT  RELIEF  VALVE  SETTING 
PSAT=(X(4) +14.3 93)/ 14 .393 
PMM=PSAT*730. 

TSAT= ( BVP/ <  AVP-AL0G10 ( PMM) ) > -CVP 
TSAT=<1.8*TSAT)+492. 

TSAT4=TSAT«4 

T3=TSAT+30. 

SOLVE  FOR  COEFFICIENTS  OF  A  CURVE  FIT  OF  THE  PHYSICAL  PROPERTIES 
OF  THE  WALL 
AO=X(  7) 

A4=4.*(.5*(X(  5)+X<  9>)-2.*(X<  3>+X(  8> >+3.*A0>/3. 

A2=2,*<X<  3)+X(  8)-2.*A0-.125*A4) 

A3=4.*<X(  9) -2. *X (  B)+A0-.5*A2-.875*A4)/3, 

A1=X(  9>-A0-A2-A3-A4 
BO=X ( 12) 

B4=4,*(.5*(X<10)+XU4)>-2,*(X(imXU3>)+3.*B0>/3. 

B2=2.*<X(11)+X(13>-2.*B0-.125*B4> 

B3=4.*<X(14>-2.*X(13)+B0-.5*B2-.875tB4>/3. 

Bl=X(14)-B0-B2-B3-B4 

YO=X( 17) 

Y4=4 . *< . 5*(X< 15)+X( 19) )-2,*(X( 16)+X( 18) )+3.*Y0)/3, 
Y2=2.*<X<13>+X(18)-2.*Y0-.125*Y4> 
Y3=4.*(X<19)-2.*X<18)+Y0-.5*Y2-.875*Y4>/3. 
Y1*X(1?>-Y0-Y2-Y3-Y4 
FIND  ANGLE  OF  INTERSECTION  OF  MENISCUS 
PHI0=PI/2, 

20  PHI1=PHIO+(PI*X(3)-(PHIO-.5*SIN(2.*PHIO)))/(1.-COS(2.*PHIO)) 
PABS=ABS(PHI1-PHI0) 

IF1PABS.LT , 1 .E-4)  GO  TO  30 
PHIO=PHI 1 
GO  TO  20 

CALCULATE  VIEW  AREAS  FOR  TWO  WALL  NODES 
30  Ll=X(l)ISIN<PHIl/4.) 

L  2=L1 
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L3=X< 1 )tSIN(PHIl) 

L4=,5*X( 1 )*SQRT(2.*( 1 . -COS < PHI 1) > ) 

L5s.5*X( 1 )*SQRT ( (COS (PHI 1/2 • )-COS(PHIl ) )*l2+(SIN(PHIl/2. ) 

A  +SIN(PHI1) )**2 ) 

L6=L4 

F35=(L5+L3-L2)/<2.*L3) 

F23=L3*(1.-F35)/L2 

F45=<L5+L4-L1)/<2.*L4) 

F14=L4*(1.-F45)/L1 

F26=<L6+L2-L1)/(2.*L2) 

F12=L2t< 1 .-F26)/L1 
F13=l .-F12-F14 

SAF1=SBC*L1*F13 

SAF2=SBC*L2*F23 

AL=.5*X(l)*SIN(PHIl/2.) 

STEADY  STATE  SOLUTION 
ISS=1 

T1 1  =  <Q*AL/SAF1+TSAT4 ) ** . 25 

T2 1=T1 1 

ris=Tii 

T  2S=T 1 1 

T10=T11 

T20=T11 

55  TN=(T11+T2 1-460. -2060. )/1600. 

K12=A0+A1*TN+A2*TN**2+A3*TN**3+A4*TN**4 

K12=K12*X<2)/(AL*12.) 

F1=Q*AL-K12*(T11-T21)-SAF1*(T11**4-TSAT4) 

DF1=-K12-4.*SAF1*T11**3 

T1N=T11-F1/DF1 

ABS1=ABS(T1N-T11) 

IFIABSI.LT. 0.001)  GO  TO  60 

T11=T1N 

GO  TO  55 

60  TN=(T11+T21 -460, -2060. J/1600, 

K12=A0+A1*TN+A2*TN**2+A3*TN**3+A4*TN**4 

K12=K12*X(2)/(AU12.) 

TN  =(T21+  T3-460. -2060. 1/1600. 

K23=A0+A1*TN+A2»TN**2+A3*TN**3+A4*TN**4 

K23=K23*X(2)/(.5*AL*12.) 

F2=Q*AL-K12*(T21-T11)-K23*(T21-T3)-SAF2*(T2U*4-TSAT4) 

DF2=-K12-K23-4.*SAF2tT2U*3 

T2N=T21-F2/DF2 

ABS2=ABS(T2N-T21) 

IF1ABS2.LT. 0.001)  GO  TO  70 

T21=T2N 

GO  TO  60 

70  ABS1=ABS(T11-T1S) 

ABS2=ABS(T21-T2S ) 

IF(ABS1.LT.. 001. AND. ABS2.LT. 0.001)  GO  TO  180 

T1S=T11 

T2S=T21 

GO  TO  55 

INTEGRATE  NODE  TEMPERATURES  AT  6  SEC  INCREMENTS— TEMPERATURES  ARE 
IN  DEGREES  RANKINE 
BEGIN  THE  ITERATION 
90  ISS=0 
TIME=0, 

Tll=520. 

T2l=520. 

T1S=520, 

T2S=520, 

100  TIME«TIME+0.1 
T 1 0*T 1 1 
T20=T21 

CALCULATE  THERMAL  CONDUCTIVITIES  AND  SPECIFIC  HEATS 
120  TN  =<Tll+T21-460.-2060« ) / 1600 • 

K12=A0+Al*TN+A2*TN**2+A3*TN**3fA4*TN**4 

K12=K12*X<2>/<AU12.) 

TN  =( 2, *T1 1-460. -2060. )/1600. 
MCVl=B0+Bl*TN+B2*TN**2+B3*TN**3+B4*TNt*4 


MCV1=MCV1*.29*X(2)*AL*144. 

F1=T11-T10-(Q*AL-K12*(T11-T21)-SAF1*<T1U*4-TSAT4))«IT/HCV1 

DF1=1.+<K12+4,*SAF1*T11**3)*DT  /MCV1 

T1N=T11-F1/DF1 

ABS1=ABS(T1N-T11) 

IFCABSl.LT. 0.001)  60  TO  140 

T11=T1N 

60  TO  120 

140  TN  c(TllFT21-460. -2060.)/ 1600. 

K12=A0+Al*TN+A2*TN**2+A3*TN«3+A4*TNt*4 

K12=K12*X(2)/CAL*12.) 

TN  =  <  T21 +  T3-460. -2060.1/1600. 
K23=A0+Al*TNfA2*TN**2+A3tTN**3+A4*TN*#4 
K23=K23*X<2)/(  ,5*AL*12.) 

TN  =( 2. *T2 1-460. -2060. J/1600. 

MCV2=B0+B1*TN+B2*TN**2+B3*TN**3+B4*TN**4 

MCV2=MCV2*.29*X(2)*AL*144. 

F2=T21-T20-(Q*AL-K12*<T21-Tll)-K23t(T21-T3)-SAF2*<T21**4-TSAT4>> 

A  ¥DT/MCV2 

DF2=1 , + ( K12+K23-4 . *SAF2*T21 *13 ) *DT  /MCV2 

T2N=T21-F2/DF2 

ABS2=ABS(T2N-T21) 

IF(ABS2.LT. 0.001)  GO  TO  160 

T21=T2N 

GO  TO  140 

160  ABS1=AB3(T11-T1S> 

ABB2=ABSf T21-T2S) 

IF(ABS1.LT. .001.ANB.ABS2.LT. .001)  60  TO  180 
T  1S=T  1 1 
T2S=T21 
GO  TO  120 

C  CALCULATE  STRESSES  AND  COMPARE  WITH  TENSILE  STRENGTH 
C  ...NOTE  THAT  THE  TEMPERATURES  WE*VE  SOLVED  FOR  ARE  THOSE  OF  THE  INSID 
C  SURFACE  OF  THE  WALL 

C  ASSUME  THAT  MAXIMUM  TEMPERATURES  ARE  AT  TOP  OF  TANK 
180  TN  =< 2. #T1 1-460. -2060. )/1600. 

K1  =A0+A1*TN+A2*TN**2+A3*TN**3+A4*TN**4 
SUI  =  Y0m*TN+Y2*TN**2+Y3*TN**3fY4*TN**4 
T1M=Q*X<2)/(K1*AL*12.HT11 
TN  =(2.*T1M-460.-2060.)/1600. 
SU0=Y0+Y1*TN+Y2*TN**2+Y3*TN**3+Y4*TNM4 
C  STRESSES  AT  INSIDE  AND  OUTSIDE 
D02=(X(1)+2.*X(2)/12.)**2 
DI2-X< 1 )IX(1 ) 

SC=X( 4)#DI2/ (D02-DI2) 

5RI=SC#( 1.-D02/DI2) 

STI=SC*( 1 .+D02/DI2) 

SZI=SC 

ERO=C.O 

ST0«?.*SC 

szo-sc 

FCC=.707107*S0RT<(SR0-ST0>**2F(ST0-SZ0)**2+(SZ0-SR0)**2) 

FCI=.707107*SQRT((SRI-STI)**2+(STI-SZI)M2+(SZI-SRI>**2) 

IF (SU0.LE.FC0.0R.su I  .LE.FCI )  GO  TO  280 

IF (ISS.EQ.O)  GO  TO  100 

X(20)=3. 

X(25)=0. 

GO  TO  301 

280  IF ( ISS.EQ. 1 )  GO  TO  90 
IF(SUO.GT.FCO)  GO  TO  300 
X  <  20 ) =2 . 

GO  TO  301 

300  X { 20 > = 1 . 

301  X(21)=FC0 
X(22)=TlM-460, 

X(23)=FCI 

Y(24)=Tll-460# 

X(25)=TIHE 

DO  310  IXDS21 f 26 
310  D( IXD)=X( IXD-i ) 

I0U7r2 

CALL  OVERT ( D  *  1 OUT ) 
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D(21 )=D(21 H0.0001 

RETURN 

END 

SUBROUT I NE  S V£ I W ( THETA » HF  >  S  >  DT » VF ) 

THIS  SUBROUTINE  IS  USED  BY  THE  RADIATION  FLUX  SUBROUTINE. 

NO  SPECIAL  INPUTS  ARE  REQUIRED  FOR  THIS  ROUTINE  BEYOND  THOSE 
LISTED  IN  SUBROUTINE  JHHRF 


RT=DT/2. 

X=S-RT 

HT=0.0 

H0=0.0 

XK=X 

XM=0.0 

Ph=0,0 

IF(THETA.LE.O.O)  GO  TO  41 

PF  -r  HT/SIN(THETA>  +  HFICOSC THETA) /SIN (THETA) 

XH  =  PM*COS(THETA> 

XF  =  XM  +  HF/SIN(THETA) 

41  RT-DT/2. 

(TV  -  VLDT 

IF(THETA)  42»42>43 

43  XC  =  PM  4-  ( X-XM )*COS( THETA) 

EXC  =  XC  +  RT 

D  =  EXC/RT 

HFA  =  (X-XH)#SIN( THETA) 

HFB  =  (XF-X)*SIN( THETA) 

GO  TO  44 

42  EXC  =  EX 

U  =  EXC/RT 
HF1=HT 

HF2  =  HF  +  HT 
GO  TO  95 

44  IF  (X-XM)  105 >205 >305 
105  HF1  =  -HFA 

HF2  =  HFB 
GO  TO  95 
205  HF2  =  HF 
HF1  =  0.0 
GO  TO  95 

305  IF  (X-XF)  405i605»705 
405  HF1  =  HFA 
HF2  =  HFB 
GO  TO  95 
605  HF2  =  HF 
HF1  =  0.0 
GO  TO  95 
705  HF1  =  HFA 
HF2  =  -HFB 
GO  TO  95 

95  ELV1  =  HF1/RT 
ELV2  =  HF2/RT 
A1  =  (D+l.)*i2  +ELVUI2 
A2  =  (D+l . )%%2  +ELV2M2 
B1  =  (D-l « )%%2  +  ELV1**2 
B2  =  (D-l.)**2  +  ELV2M2 
ARGA1  =  ELV1/((D**2-1.)**.5) 

ARGA2  *  ELV2/( (D**2-l . )tt .5) 

ARGB1  =  <<Alt(D-l.))/(Bl*(D+l. >>)**. 5 
ARGB2  =  <(A2*(D-1.))/(B2*(D+1. )>>**. 5 
ARGC  =  ((D-1.)/(D+1.))**.5 

FI  =  ( 1 . / (3, 14164D) )*ATAN( ARGA1 )  4  (ELV1/3. 1416>*( ( ( A1-(2.*D) )/ 
1 (Dt( ( AltBl ) tt<5) ) )*ATAN( ARGB1 )  -  ( 1 ./D)tATAN(ARGC) ) 

F2  =  <l./(3.1416*D))*ATAN(ARGA2)  4  (ELV2/3. 1416)*( ( (A2-(2.*D) )/ 
1(D*<(A2*B2)*|.5)))|ATAN(ARGB2)  -  < 1 ./D)*ATAN< ARGC) ) 

IF  (HO)  580'560»582 

580  IF(THETA)  118>UB>45 
582  IF  (THETA)  117,117>581 

581  IF  <XK  -  XF)  117iU6f  119 

45  IF  (X-XM)  118>116r90 
90  IF  (X-XF)  117>116>119 
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116  VF  =  F2 
GO  TO  96 

117  VF  =  F2  +  FI 
GO  TO  96 

118  VF  =  F2-F1 
GO  TO  96 

119  VF  *  FI  -  F2 
96  RETURN 

END 

OVERLAY (5?0) 
PROGRAM  0V5 


0V5  EXECUTES  THE  FOLLOWING  INTER-RELATED  GROUP  OF  VAPOR 
DISPERSION  RATE  MODELS  - 


RATE  MODEL  = 


INDEX  = 


COMMON  VARIABLES  USED  -  MODNO 

SUBROUTINES  REQUIRED  -  MODC1 ?M0DC2?M0DG?M0DJ?M0DN?Mt)DS?M0DU? 

TRACE 

AUTHOR  -  R.G.  POTTS?  ARTHUR  D.  LITTLE?  INC.? 

35/309A  ACORN  PARK? 

CAMBRIDGE?  MASS.?  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  8  JANUARY  1976 


C0MM0N/0VCNT/H0DN0?0VLST(29)?SGLST(29) 
INTEGER  OVLST?SGLST 


—-PRINT  OVERLAY  EXECUTION  TRACE  MESSAGE?  THEN  BRANCH  ON  MODEL 
INDEX  NUMBER 
CALL  TRACE(0?5?0) 


C . SELECT  MODEL  C 

IF (MODNO.NE.3)  GO  TO  10 
CALL  M0DC1 
CALL  M0DC2 
GO  TO  100 
C 

C - SELECT  MODEL  G 

10  IF(M0DN0.NE.7)  GO  TO  20 
CALL  MODG 
GO  TO  100 
C 

C . SELECT  MODEL  J 

20  IF(MODNO.NE.IO)  GO  TO  30 
CALL  MODJ 
GO  TO  100 
C 

C . SELECT  MODEL  N 

30  IF(M0DN0.NE.14>  GO  TO  40 
CALL  MODN 
GO  TO  100 
C 

C . SELECT  MODEL  S 

40  IF(M0DN0.NE.19)  GO  TO  50 
CALL  MODS 
GO  TO  100 
C 

C . SELECT  MODEL  W 

50  IF(M0DN0.NE»23)  GO  TO  100 
CALL  MODW 
C 


r-X  -sj*.  •M-' 


n- 


-PRINT  OVERLAY  EXECUTION  TRACE  MESSAGE.  THEN  RETURN  TO  MAIN 


C  HACS  CONTROL 

100  CALL  TRACE( 1 » 5.0) 

C 

END 

SUBROUTINE  CONVAP(X. Y.Z.T.H.MDOT .UUIND. I ATM. IDIM. SIZE. CHNLU.C) 
C 


c 

r 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


THE  NAME  OF  THIS  PROGRAM  IS  CONVAP.  IT  RETURNS  THE  VALUE  OF 
CONCENTRATION  (GM/CMM3)  AT  POINT  X.Y.Z.  AT  TIME  T  FOR  VAPOR 
RELEASE  FROM  A  CONTINUOUS  SOURCE.  BOTH  CIRCULAR  AND  ONE-DIMENSIONAL 
SOURCES  ARE  CONSIDERED. 


INPUT  ARGUMENTS 

X  =  MIND  DIRECTION  CO-ORDINATE 
Y  =  CROSS  WIND  CO-ORDINATE 
Z  =  HEIGHT  CO-ORDINATE 
T  =  TIME  AFTER  THE  SPILL/LEAK  AT  WHICH  THE 
CONCENTRATION  IS  DESIRED. 

H  =  HEIGHT  OF  THE  CENTER  LINE  OF  THE  SOURCE  ABOVE 
GROUND 

MDOT  =  AVERAGE  RATE  OF  GAS  OR  VAPOR  DISCHARGE 
UUIND  =  WIND  VELOCITY 

IATM  =  ATMOSPHERIC  CONDITION  AS  DEFINED  IN 
SUBROUTINE  JHHDC 

IDIM  =  DIMENSION  OF  SPILL  (1  IF  ONE  DIMENSIONAL. 

2  IF  RADIAL) 

SIZE  =  MAXIMUM  RADIUS/LENGTH  OF  POOL. 

CHNLW  =  CHANNEL  WIDTH  (REQUIRED  FOR  IDIM=1  ONLY) 

OUTPUT  ARGUMENTS 


VAPOR  CONCENTRATION 


CMS 

CMS 

CMS 

SECS 

CMS 

GM/SEC 

CMS/SEC 


CMS 

CMS 


GMS/CMM3 


c*mm*m*mmmmmmmm*mt*mm*m*m***m*m**m 

c 

REAL  MDOT 
PI=3 . 141592654 


C 

C 

C 

C 

C 


CHECKING  TO  SEE  IF  THE  CLOUD  HAS  REACHED  POINT  XYZ  OR  UHETHER 
THE  TRAILING  EDGE  OF  THE  CLOUD  HAS  PASSED  THE  POINT. 

TRVLT  IS  THE  TRAVEL  TIME  FOR  WIND  BETWEEN  THE  SOURCE  AND  POINT  XYZ. 

TRVLT=X/UWIND 
IF (T-TRVLT)  10.20.20 
10  C=0.0 
RETURN 

20  VIRDIS=10.*SIZE 
IF(IDIM-l)  40.40.50 
40  A=CHNLW*SIZE 

VIRDIS=10.*SQRT(A/PI) 

50  XC=X+VIRDIS 

CALL  JHHDC (XC. IATM.SIGY.SIGZ) 

CO=MDOT/(2.IPI*SIGY*SIGZ*UWIND) 

D1=EXP(-1.*((Z-H)*(Z-H)/<2.*SIGZ*SIGZ))) 

D2=EXP<-1.*((Z+H>*(Z+H)/(2.*SIGZ*SIGZ))> 

C3=EXP<-1,*Y*Y/(2.*SIGY*SIGY)) 

C=C0tC3*(Dl+D2) 

RETURN 

END 

SUBROUTINE  ITOX(CHAZ.AM.IFLAG.C) 

THIS  ROUTINE  CONVERTS  VAPOR  CONCENTRATIONS  EXPRESSED  IN  UNITS 
OF  MOLE  PERCENT  OR  PPM  TO  UNITS  OF  GM/CMM3. 


C 
C 
C 

c 

C*miNPIJTS 
C  CHAZ 

i' 

<:  am 

C  IFLAG 


THE  CONCENTRATION  OF  THE  CHEMICAL  VAPOR  OR  GAS  IN  AIR 
(MOLE  PERCENT  IF  IFLAG  IS  0.  PPM  IF  IFLAG  IS  1) 

MOLECULAR  WEIGHT  OF  THE  CHEMICAL 

FLAG  INDICATING  WHETHER  MOLE  PERCENT  OR  PPM  CONCENTRATION 
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IS  BEING  GIVEN  AS  INPUT 


CfttttOUTPUTS 

C  THE  CORRESPONDING  CONCENTRATION  IN  GH/CNW3. 

I F < I FLAG -0 )  20.20.10 
10  CHAZ=CHAZ/ 1000000.0 
GO  TO  25 

20  CHAZ=CHAZ/100.0 
25  DENV=AM/22414. 

BENA=  0.0012894 

C-l . /<  < 1 . /DENV)  +  <  < ( 1 . -CHAZX28. 9)/(CHAZIAM*DENA) ) ) 

IF( IFLAG.EQ.0)  CHAZ=CHAZ*100.0 
IF ( IFLAG .EQ . 1 )  CHAZ=CHAZtl000000 . 0 
RETURN 
END 

SUBROUTINE  IVAPC<TMG»UWIND»H»C»X»Y.IAC»IDIM»SW»SIZE»CHNLW.TIME.DUR 
1N.JFLAG) 

tmmmmtuumummmmmmmmtummtttmmmm 

THIS  ROUTINE  IS  THE  INVERSION  OF  ROUTINE  VAPC.  IT  GIVES  THE  UIDTH 
OF  A  GIVEN  CONCENTRATION  LEVEL  IN  A  VAPOR  CLOUD  AT  ANY  POSITION  X 
DOWNWIND  AT  THr  GROUNDLEVEL.  IT  ALSO  RETURNS  THE  TINE  OF  ARRIVAL 
OF  THE  CLOUD  At  DOWNWIND  CENTERLINE  POSITION  X  AND  THE  DURATION 
FOR  WHICH  THE  VAPOR  CONCENTRATION  REMAINS  ABOVE  A  HAZARDOUS  LEVEL 
AT  A  SPECIFIED  POSITION  X.Y. 

*****  INPUT  ARGUEk‘ ENTS 

TNG  TOTAL  WEIGHT  OF  VAPOR  DISCHARGED  GRANS 

UHIND  MEAN  WIND  VELOCITY  IN  SPILL  AREA  CH/SEC 

H  HEIGHT  OF  THE  CENTERLINE  OF  THE  DISCHARGE 

HOLE  ABOVE  GROUNDLEVEL  CMS 

C  HAZARDOUS  CONCENTRATION  WHOSE  CONTOUR  WIDTH 

IN  THE  CLOUD  IS  DESIRED  GM/CH**3 

X  DOWNWIND  CENTERLINE  DISTANCE  AT  WHICH  THE 

SPECIFIC  CONTOUR  WIDTH  IS  DESIRED  Ch 

Y  ANY  CROSSWIND  POSITION 

(MEASURED  FORM  CENTERLINE  DOWNWIND  DIRECTION)  CM 
IAC  ATMOSPHERIC  CONDITION  FLAG 

<  1  TO  6  FOR  CONDITIONS  A  TO  F  RESPECTIVELY) 

SIZE  THE  LENGTH  OR  RADIUS  OF  THE  VAPOR  SOURCE 

DEPENDING  ON  IDIM  DEFINITION  Ch 

CHNLW  WIDTH  OF  VAPOR  SOURCE  (  FOR  IDIM=1  ONLY)  CM 

***  OUTPUT  ARGUEMENTS 

SW  HALF  WIDTH  OF  THE  ZONE  IN  THE  CLOUD  THAT 

IS  AT  OR  ABOVE  CONCENTRATION  C  AT  X  CM 

TIME  ELAPSED  TIME  WHEN  CLOUD  REACHES  DOWNWIND 

DISTANCE  GIVEN  BY  X  SEC 

DURN  TIME  SPAN  DURING  WHICH  CONCENTRATION  AT 

POINT  X.Y  WILL  EXCEED  C  SEC 

JFLAG  FLAG  INDICATING  WHETHER  POINT  X.Y  IS  INSIDE 

OR  OUTSIDE  THE  HAZARD  ZONE.  <1=INSIDE.  2*0UTSIDE> 


c******m**t***x*tm**m**tt****t*********t*t*****t****t************t 

PI=3. 14159256 
IF ( IDIM-1 )  30.30.40 
30  A=SIZE*CHNLW 
SIZE=SQRT ( A/PI ) 

40  FACT=10.*SIZE 
X=X+FACT 

CALL  JHHDC(X. IAC.SIGY.SIGZ) 

SIGX=SIGY 

C1=(TMG/(<2.*PI)**1.5*SIGX*SIGY*SIGZ)) 

A1=EXP(-H**2/<2.*SIGZ**2>) 

A2=EXP<-H**2/<2.*SIGZ**2>> 

C3*C1*A2 

C2=C1*A1 

C0-C24C3 
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X=X-FACT 
3W=0 . 

IF(C.GE.CO)  GO  TO  5 
SW=SIGYISQRT  (2.*AL0G(C0/C) ) 

5  CONTINUE 

IF(SW.LE.O.O)  TIME=0.0 
IF(SU.GT.O.O)  TIME® (X-SW)/UWIND 
IF (Y-SW) 10*20*20 

10  DURN=2.*SQRT (SW**2-Y$I2) /UWIND 
IF  ( IDIM-1 )  70*70*80 
70  SIZE=A/CHNLW 
80  JFLAG=1 
RETURN 
20  JFLAG=-1 
DURN---0. 

IF ( IDIM-1 )  50*50*60 
50  SIZE=A/CHNLW 
60  RETURN 
END 

SUBROUTINE  IVAPCN(X* Y*Z,H*SORDRN*MDQT*SIZE.IDIM*CHNLW.UWIND.IATM, 
ICrSU, TIME, BURN) 

C 

cutimttttumtmmmmmmmummmmmmmtmmm 

c 

IVAPCN  STANDS  FOR  INVERSION  OF  CONTINUOUS  VAPOR  DISPERSION 
MODEL.  IT  RETURNS  A  VALUE  FOR  THE  MAXIMUM  UIDTH  TO  A 
CONCENTRATION  CONTOUR  AT  ANY  DOWNWIND  DISTANCE  X  AND  VERTICAL 
LOCATION  Z.  THE  SOURCE  IS  A  CONTINUOUS  SOURCE.  THE  ROUTINE 
ALSO  RETURNS  A  VALUE  FOR  THE  FLAG  JFLAG  DEPENDING  ON  WHETHER  THE 


POINT  Y  IS  WITHIN  THE  CLOUD  OR  NOT. 
INPUT  ARGUMENTS 


Y  * 

Z 

H  = 

SORDRN= 
MDOT  = 
SIZE  = 
IDIM  = 

CHNLW  = 
UWIND 
IATM 
C 


DOWN  WIND  POSITION  AT  WHICH  THE  MAXIMUM 
WIDTH  OF  HAZARD  ZONE  IS  TO  BE  KNOWN. 

ANY  CROSS  WIND  POSITION. 

Km  smim*  LINE  OF  THE  HOLE  ABOVE 
GROUND. 

DURATION  FOR  WHICH  THE  SOURCE  IS  ACTIVE. 
AVERAGE  RATE  OF  GAS  OR  VAPOR  DISCHARGE 
MAXIMUM  RADIUS/LENGTH  OF  POOL. 

DIMENSION  OF  SPILL  (1  IF  ONE  DIMENSIONAL* 

2  IF  RADIAL) 

CHANNEL  WIDTH  (REQUIRED  FOR  IDIH=1  ONLY) 
WIND  VELOCITY 
ATMOSPHERIC  CONDITION. 

HAZARDOUS  CONCENTRATION-WHOSE  CONTOUR  WIDTH 
IS  TO  BE  KNOWN. 


CMS 

CMS 

CMS 

CMS 

SECS 

GM/SEC 

CMS 


CHS 

CHS/SEC 


GMS/CM**3 


OUTPUT  ARGUMENTS 

SW  =  HALF  WIDTH  OF  THE  HAZARDOUS  ZONE. 

TIME  »  TIME  OF  ARRIVAL  AT  X  OF  THE  HAZARDOUS  CONC. 
DURN  ®  DURATION  FOR  WHICH  HAZARDOUS  CLOUD  AT  XYZ 


CMS 

SECS 

SECS 


c 

REAL  MDOT 
PI=3. 141592654 
A=PI»SIZE»SIZE 
VIRDISs10. tSIZE 
IF ( IDIM-1 )  10.10*20 
10  A*CHNLW*S1ZE 

VIRDIS=10.*SQRT(A/PI) 

20  XCsX+VIRDIS 

CALL  JHHDC(XC.IATM.SIBY.SIOZ) 
C0=MD0T/(2.*PI*SIGY*SIGZ*UWIND) 

D1*EXP(  -1  .*(  (Z-HX(Z-H>/(2  .tSIGZtSIGZ) ) ) 
D2«EXP(-1.*((Z+H)*(Z+H)/(2.*SIGZ*SIGZ)>) 
F=C/(C0*(D1+D2) ) 

SW*0. 
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CMAX=C0*(D1+D2) 

IF (C-CHAX)  30,40,40 
30  SW=SGRT(-2.*SIGY*SIGY*AL0G(F)) 

40  IF(SU.LE.O.O)  TIME=0.0 
IF(SW.GT.O.O)  TIME=X/UWIND 
DURN=SORDRN+TIME 
IF(TIME.EQ.O.O)  DURN=0.0 
RETURN 
END 

SUBROUTINE  JHHDC ( XXL , I AC , SIGY , SIGZ ) 

XL  IS  THE  X  COORDINATE  OF  POINT  WHERE  CONCENTRATION  IS  TO  BE 
CALCULATED  UNPUT  IN  CM) 

IAC  INDICATES  WEATHER  CONDITIONS  AT  TIME  OF  SPILL  (INPUT) 
IAC*1  FOR  EXTREMELY  UNSTABLE  CONDITIONS  (A) 

IAC=2  FOR  MODERATELY  UNSTABLE  CONDITIONS  (B) 

IAC*3  FOR  SLIGHTLY  UNSTABLE  CONDITIONS  (C) 

I  ACM  FOR  NEUTRAL  CONDITIONS  (D) 

IAC*5  FOR  SLIGHTLY  STABLE  CONDITIONS  (E) 

IAC-6  FOR  MODERATELY  STABLE  CONDITIONS  (F) 

SIGY  AND  SIG2  ARE  DISPERSION  COEFFICIENTS  (OUTPUTS) 


THE  FORMS  OF  THE  EQUATIONS  USED  IN  THIS  ROUTINE  AND  THE 
COEFFICIENTS  UTILIZED  IN  THEM  WERE  DETERMINED  BY  LEAST 
SQUARE  FITTING  PROGRAMS  TO  BEST  REPRESENT  THE  DISPERSION 
COEFFICIENT  CURVES  GIVEN  BY  GIFFORD  AND  PASQUILL. 

THE  SIMPLIFIED  EQUATIONS  USUALLY  FOUND  IN  THE  LITERATURE 

WERE  FOUND  TO  BE  CONSIDERABLY  IN  ERROR  UNDER  MANY  CIRCUMSTANCES. 


DIMENSION  AO(6),AONE(6),ATUO(6),S(5,5),ER(6) 
DATA 


* 

S( 1  *  1 ) 

/ 

.90  /, 

S(2,l) 

/ 

.913/, 

S(3, 1 ) 

/ 

.919/, 

* 

S(4, 1 ) 

/ 

.919/, 

S (5, 1 ) 

/ 

.919/, 

* 

S( 1 , 2) 

/158,  /, 

S(2,2) 

/104.  /, 

S(3,2) 

/ 

69.  /, 

* 

S  ( 4 » 2 ) 

/ 

51.  /, 

S(5,2> 

/ 

34.  /, 

* 

S(l,3) 

/ 

2.041/, 

S (2,3) 

/ 

1.786/, 

S(3,3) 

/ 

1.505/, 

* 

S<4,3) 

/ 

1.332/, 

S(5, 3) 

/ 

1.146/, 

* 

SUM) 

/ 

1.048/, 

S  ( 2 » 4 ) 

/ 

.916/, 

S(3,4) 

/ 

.737/, 

* 

3(4,4) 

/ 

.678/, 

S(5, 4 ) 

/ 

. 650/ , 

* 

S(l,5) 

/ 

.041/, 

S  ( 2 , 5 ) 

/ 

.000/, 

S(3,5) 

/ 

-.105/, 

* 

S(4,5> 

/ 

-.112/, 

S(5,5) 

/ 

-.113/ 

DATA  A0(1)  /-I . 1840665/ »A0( 2) /-I • 194544/ »  A0(3)/-l ,1446466/f 

*  A0(4)  /-I . 4521 136/, AO (5) /-I .793439/ ,  A0<6)/-2. 0571470/ 

DATA  AONEU)/  . 59323084/ fA0NE(2)/1 . 0679426/, A0NE<3>/1 .0130453/, 

*  A0NE(4)/1. 2195024  / »AONE (5) /I . 3995561/ .A0NE(6)/1 .47180410/ 
DATA 

*  ATWO(l)/  . 2305835 1/,ATW0(2)/  .0033788564/, ATW0(3>/-. 012671455/, 

*  ATW0(4)/-. 0800502  /fATW0(5)/-. 11727572  /rATU0<6>/-, 13377112  / 

DATA  ER( 1 )/• 098  /,ER<2)/. 1726/, ER(3)/. 1116/, 

*  ER(4)/.1314/fER(5)/.1187/fER(6)/.1186/ 

xl=xxl 

xl=xl/ioo. 


IF (XL .LT .1.0)  XL=  1 « 0 
IFUAC-1)  70i 70» 20 

20  IFUAC-4)  21 ,10,10 

21  IF(XL-1000.)  30,30*10 


30  IAC=IAC-1 

SIGY*S(IAC,2)*( (XL/1000. >**S(IAC,1>) 

3IGZ=S( IAC ,3)+<S(IAC, 4 )*<(ALOG (XL/1000. ) )/2.303))+(S( IAC,5)*( ( (ALO 
1G(XL/100.))/2.303)**2)) 

IAC=IAC+1 

IF(XL-J0000. )  60,60,31 

31  SIGY=3IGY-(((AL0G(XL)/2.303)-4.)*ER(IAC)*SIGY) 

GO  TO  60 

10  IACMAC-1 

SIGY=S(IAC,2)*( (XL/1000. >**S(IAC,1)) 

IACMAC+1 

IF (XL- 10000. ) 80 *80 ,83 

83  SIGY=SIGY-( ( (ALOG( XL 5/2.303) -4, )*ER( IAC)*SI6Y) 

80  SIGZ=AO( IAC) +( AQNE( IAC)* ( ALOG(XL )/2 .303) )4( ATUO( IAC)*( ( ALOG(XL)/ 
12. 303)4*2. ) ) 

GO  TO  60 

70  SIGY=- .227589994 . 84761524* (ALOG( XL) /2. 303) 
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72 

71 

81 


82 

60 


SIGY=EXP(2.303*SIGY) 

IF (XL -2000 .) 71 .71 .72 

SIGY=SIGY+( <  < ( ALOG ( XL )/2. 303) -3. 30103 )/l. 65321251 )tER(l)tSIGY) 
CONTINUE 

IF (XL-1000* )  81 >81>80 

SIGZ=3. 338834+(-2.8047118*(AL0G(XL>/2. 303) )  +  ( . 86706924$ ( (ALOG (XL)/ 
12.303)$$2.>) 

IF (XL-100.0)  82 >82 >60 
S I GZ  =  - 1 .0055+ (0.468524 ALOG (XL) ) 

CONTINUE 

SIGZ=EXP(2.303*SIGZ) 

SIGY=SIGY#100 . 

SIGZ=SIGZ*100. 

XL=100.*XL 

RETURN 

END 

SUBROUTINE  M0DC1 

SUBROUTINE  M0DC1  IS  A  PART  OF  THE  GENERALIZED  VAPOR  DISPERSION 
MODEL  C,  IT  FINDS  THE  MAXIMUM  EXTENTS  OF  FIRE  AND  TOXICITY 
HAZARDS  OF  A  CLOUD  OR  PLUME  USING  ROUTINES  VAPC  AND  CONVAP  FOR 
INSTANTANEOUS  AND  CONTINUOUS  RELEASES  RESPECTIVELY.  FOR  AN 
INSTANTANEOUS  RELEASE >  IT  ALSO  GIVES  THE  CONCENTRATION  VS  TIME 
AT  A  USER  SPECIFIED  POINT. 

COMMON/'C/PLTYP>XBX(  150) 

INTEGER  PLTYP 

DIMENSION  AC(20>2) >AX(20) >AT(20) > ASAVC(20) >ASAV(20) 

ODIMENSION  PTITL(6)>PTIT(6) >XTITL1 (6) >XTITL2(6) >XTITL3(6) > 

1  XTITL4(6) >YTITL1 (6) >YTITL2(6) 

EQUIVALENCE  (XBX( 1 ) > AT ( 1 ) ) > (XBX(81 ) >AX( 1 ) ) > ( XBX (21 ) > AC(1 > 1) ) 
<XBX(64)>IC1PF)>(XBX(61)>X)> (XBX(62) >Y) 

(XBX (63) >Z) > (XBX (65) >AM) 

(XBXC 101 ) > ASAVC( 1 ) ) > (XBX( 121 ) >ASAV( 1 ) ) 

Cl  / 

( I ) > 1=1 >6)/8HC0NCENTR>BHATIDN  VS>8H  TIME  AT > 

FIXED.'  H  POINT  ->8H  MODEL  C/ 

(PTIT  (I) >1=1. 6)/8HMAX  GR0U.8HND  CONC  >8HVS  TIME/. 


EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
DATA  MOD/  1H 
ODATA  (PTITL 
18H  A 
ODATA 

18HDISTANCE.8H  -  MODEL. 8H  C  / 

ODATA  (XTITL1 ( I ) . 1  =  1 . 6) /8HELAPSED  .BHTIME, . • . >8H . . 

. . . . (.8HMINUTES)/ 

ODATA  (XTITL2(I).I=1.6)/8HELAPSED  .8HTIME, . . , »8H . . 

13H. ....... »8H. »8H. ( HOURS ) / 

ODATA  ( XTITL3( I ) . 1=1 >6)/8HD0WNWIND.8H  DISTANC.8HE . . 

. . . . .  METERS)/ 

ODATA  (XTITL4(I) »I  =  1»6)/8HELAPSED  .8HTIME. . , . »8H . . 

18H. . . . . ( .8HMINUTES)/ 

ODATA  ( YTITL1 ( I ) > 1=1 .6)/8HC0NCENTR»BHATI0N  .8HAT  POINT. 
18H  XYZ  »8H(M0LE  PE.8HRCENT)  / 

ODATA  ( YTITL2 ( I) . 1=1 >6)/8HMAXIMUM  >1H  .8HC0NCENTR. 
18HATIQN  .8H(M0LE  PE.8HRCENT)  / 

1  CONTINUE 
IR=0 
LP=6 
ZR  =  0 . 

IS=6 

TR=0, 


ACCESS  DATA  ITEMS 
BEGPR(MOD) 

IRCL(2061 . INC. IS. ZR) 
FRCL< 1002. AM. IS. IR) 
FRCL(2012.X»IS. IR) 
FRCH2013.  Y.  IS.  IR) 
FRCL(2014 »Zi IS. IR) 
FRCL(2015.H.IS.IR) 
FRCL(2016.UUIND. IS 
I RCL (2017. IAC. IS. IR) 
IRCL  ( 2018.  DIM .  IS » IR ) 
FRCL(2019.SIZE. IS.IR) 


CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 

IF ( IDIM.EQ.l)  CALL  FRCL(2020»CHNLU. IS.IR) 


IR) 
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C 

C 

c 


c 

c 

c 


81 


8882 

8883 


51 


57 


CALL  FRCL(2032,CT0XrIS»IR> 

CALL  FRCL(2033>CFIR> ISi IR) 

CALL  FRCL(2054 .AIRTM> IS » IR) 

IF (INC.EQ.O)  CALL  FRCL<4001 »TMG» IS» IR) 

IF( INC.EQ. 1 >  CALL  FRCL(4044>FLOU>IS,IR) 

IF(INC.EQ.l)  CALL  FRCL(4045»S0RDRN,IStIR> 

CALL  FRCL(4068» AVTEhf IS» IR) 

CALL  IRCL(3004» IC1PF » IS» IR) 

CALL  IRCL(3005 r IC2PF » IS» IR) 

IW=0 

IF( INC.EQ.O)  GO  TO  93 
IF< IC1PF.EQ. 1 .OR. IC1PF.EQ.3)  IW=1 
IF ( IC2PF ,LE« 1 . AND . IU.EQ.l)  IU=2 
IF (IC2PF , Ed, 0. AND. IM. EQ.2)  IC2PF=2 
IF(IC2PF .EQ.l. AND .IU.EQ.2)  IC2PF=3 
IF( IW.EQ.O.OR. IU.EQ.2)  GO  TO  93 
IF (IC2PF .GE.2)  IU=3 
CONTINUE 

IF(IC1PF  -  2)  4»2»2 
CALL  FRCL(2035,XMX,IS>IR) 

CALL  EPRNT(NOD» IS» IR» IL ) 

IF(IL.EQ.l)  GO  TO  99 
IF (IL.EQ.2)  GO  TO  1 
CALL  OUTPR<MOD) 

FIND  RELATIVE  DENSITY  OF  GAS  OR  VAPOR  WITH  AIR  AT  DISCHARGE 

D A IR=( 0.079987+ ( -0, 000237$ AIRTH) ) 10.01603 
CALL  CONPG( AM» AVTEH»DGAS) 

RATIO=DGAS/DAIR 

ITERATE  TO  FIND  HAX  EXTENTS  OF  FIRE  AND  TOXICITY  HAZARDS 

IF (CFIR.NE.O.O)  CALL  IT0X(CFIRrAM,0,CFIRE> 

IF(CTOX.NE.O.O)  CALL  ITOX(CTOX» AM» 1 iCTOXX) 

IXX=1 

IF(CFIR.EQ.O.O)  XNN-0.0 
IF(CFIR.EQ.O.O)  GO  TO  65 
CHAZ=CFIRE 
ISTP=0 

IF < INC  .EQ.  0  .AND. TNG. GT.  0,)D0  TO  8882 

IF(INC.NE.O)GO  TO  8883 

DX=-32816,/6. 

GO  TO  8883 

IF (INC.EQ.O)  DX= ( (6355. *AL0G10(TMG> ) -32816. )/6. 

IF < INC. EQ . 1 )  DX=305.0 
IF(DX.LT. 305.0)  DX=305.0 
IF(H.LE.l.O)  GO  TO  80 
IFdDIM.EQ.2)  ADDJ=10.*SIZE 

IF( IDIM.EQ. 1 )  ADDJ=10.*SQRT(CHNLW*SIZE/3. 14159) 

XONE=305«+ADDJ 

XTWO=XONE 

XJH=XONE 

CALL  JHHDC(XONE»IAC»SIGY»SIGZ) 

SSS=H*H/(2.*SIGZ*SIGZ) 

A A AA= 100000000.0 
IF(SSS.GT ,87. )  CNC1=0.0 
IF (SSS.GT ,87 . )  GO  TO  51 

IF (INC.EQ.O)  CNC1=AAAA/<SIGY*SIGY*SIGZ*EXP(H*H/<2.*SIGZ*SIGZ>>> 
IF(INC.EG.l)  CNC1=AAAA/(SIGY*SIGZ*EXP(H*H/(2.*SIGZ*SIGZ))) 
XTW0=((XTW0-ADDJ)*2,0)+ADDJ 
CALL  JHHDC(XTWO» IAC»SIGYi SIGZ) 

SSS=H*H/(2.*SIGZ*SIGZ) 

IF (SSS.GT ,87. )  CNC2=0.0 
IF (SSS.GT ,87. )  GO  TO  57 

IF (INC.EQ.O)  CNC2=AAAA/(SIGY*SIGY*SIGZ*EXP(H*H/(2,*SIGZ*SIGZ))> 
IF( INC, EQ.l)  CNC2«AAAA/(SIGY*SIGZ*EXP<H*H/(2.*SIGZ*SIGZ))) 
CONTINUE 

IF (CNC2 ,LT ,CNC1 )  GO  TO  52 

CNC1*CNC2 

XONE=XTUO 

GO  TO  51 
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52  XJHH=ABS(XJH-XONE> 

IF(XJHH.LT.O.l)  GO  TO  47 
A=150. 

IM=0 

54  XTHRE=XONE+A 

CALL  JHHDC (XTHREr IACrSIGY r  SIGZ  > 

SSS=H*H/(2.*SIGZ*SIGZ) 

IF (SSS . GT . 87. )  CNC3=0.0 
IF (SSS.GT <87. )  GO  TO  58 

IF ( INC.EQ. 0>  CNC3=AAAA/(SIGY*SIGY*SIGZ*EXP(H*H/(2.*SIGZ*SIGZ>>> 
IF< INC.EQ. 1 )  CNC3=AAAA/(SIGY*SIGZ*EXP(H*H/(2.*SIGZ*SIGZ> )) 

58  CONTINUE 

IF( IM.EQ. 1)  GO  TO  53 

IF(CNC3.LT.CNC1.AND.A.EQ.150. )  A=-300.00 
IF(CNC3.GE.CNC1. AND . A  .EQ. 150. )  A=300,00 
IF (CNC3.LT . CNC1 . AND. A.EQ. 100. )  A=-100.0 
IF(CNC3.GE.CNC1.AND.A.EQ.100.)  A=100.0 
IN=1 

GO  TO  54 

53  IF ( CNC3 . LT . CNC1 )  GO  TO  721 
CNC1=CNC3 

X0NE=XTHRE 

IM=1 

GO  TO  54 
721  B=ABS(A) 

IF(B.EQ.100.)  GO  TO  56 
IM=0 
>-.  =  100,0 
GO  TO  54 

56  IF( IDIM.EQ.2)  XMN=XONE- ( 10 . *SIZE ) 

IF(IDIH.EQ.l)  XMN=XONE- ( 10. *SQRT(CHNLU*SIZE/3. 14159)) 

47  IF ( INC.EQ, 0)  CCCC= ( CNC1/AAAA ) * ( 2 , *THG/ ( ( 2 . *3 . 14159265 >**1 . 5 ) ) 

IF ( INC.EQ , 1 )  CCCC=(CNC1/AAAA)*(FL0W/(3.14159265*UUINB>> 

IF (XJHH . LT . 0 . 1 )  GO  TO  80 
GO  TO  50 
80  XHN=DX 
50  TYME=XMN/UWIND 

IF ( INC »EQ,0 )  CALL  VAPC(XMNrO.OrO .Or TYMEr TMGr HrUUINDt IACr IDIHr SIZE 
lrCHMLWrCNCNT) 

IF ( INC ,EQ, 1 )  CALL  C0NVAP(XMNr0.0r0.0r TYMEr Hr FLOWrUUINDr IACr IDIHr 
ISIZErCHNLUrCNCNT) 

IF ( CNCNT-CHAZ )  55r65r45 
45  IF ( ISTP  .EQ . 2 )  GO  TO  55 
SLEFT^XMN 

USE  GOLDEN  SECTION  SEARCH  TO  BRACKET  MAX  HAZARD  EXTENT 

ISTP=1 

XKN=XHN*2. 

SRGT=XHN 
GO  TO  50 


USE  BISECTION  TECHNIQUE  TO  ZERO  IN  ON  ANSWER 


IF (CNCNT .LE.CHAZ)  SRGT=XHN 
IF(CNCNT.GT.CHAZ)  SLEFT=XMN 
IF (SRGT-SLEFT-DX)  66r66r75 
66  XMN=SRGT 
GO  TO  65 
75  ISTP=2 

70  XMN=( (SRGT-SLEFT)/2. HSLEFT 
GO  TO  50 

65  IF(IXX.EQ.l)  XFIR=XMN 
IF (IXX.EQ.2)  XTOX=XMN 
IF ( IXX.EQ.2)  GG  TO  85 
IXX=2 

IF(CTOX.EQ.O.O)  XT0X=0 . 0 

IF (CTOX ,EQ. 0 . 0)  GO  TO  105 

ISTP=0 

CHAZ=CTOXX 

GO  TO  81 
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PRINTOUT  AND  SAVE  HAZARD  EXTENTS 

85  IF(H.LE .1.0)  GO  TO  105 
IF (CCCC.LT .CFIRE)  XFIR=305. 

IF(CCCC.LT.CTOXX)  XTOX=305. 

105  CALL  FSV(4010»XFIR,4) 

CALL  FSV(4043,XT0X,4) 

CALL  FSV(4069,RATI0,4) 

IF(XFIR.EQ.O.O)  CALL  PAGER<3) 

IF (XFIR.EQ.0.0)  WRITE(LP» 100) 

IF(XTOX.EQ.O.O)  CALL  PAGERC3) 

IF(XTOX.EQ.O.O)  UR1TE(LP, 110) 

IF(XFIR.GT. 305.0. AND. XT0X.GT. 305.0)  GO  TO  140 
IF(XFIR.EQ. 305.0)  CALL  PAGER(3) 

IFCXFIR.EB. 305.0)  URITE(LP,120) 

IF(XT0X.EQ. 305.0)  CALL  PAGER (3) 

IF(XT0X.EQ. 305.0)  WRITE(LP,130> 

140  CALL  ENDPR(MOD) 

DETERMINE  WHICH  PLOTS  OR  TABLES  ARE  DESIRED  AND  PROCEED  TO  THE 
APPROPRIATE  SECTION  OF  PROGRAM 

IF(IC1PF , EQ.O. AND.IC2PF .EQ.O)  GO  TO  40 
IF(IC2PF.EQ,2)  GO  TO  90 
IF(IC2PF.EQ.3)  GO  TO  90 
IF(IClPF.EQ.l)  GO  TO  90 
IF (IC1PF ,EQ.3)  GO  TO  90 
GO  TO  86 

CALCULATE  DATA  FOR  PLOT  AND  TABLE  OF  CONCENTRATION  VS  TIME 
AT  USER  SPECIFIED  POINT  IF  SPILL  IS  INSTANTANEOUS 

90  IF (IC2PF .NE.O. AND. IC2PF.NE. 1)  60  TO  91 
GO  TO  92 

91  CALL  PAGER<0) 

CALL  PAGER (3) 

WRITE<6>95) 

CALL  PAGER(l) 

URITE(6.20) 

CALL  PAGER(2) 

WRITE (6/25) 

92  CONTINUE 

IF ( IDIM.EQ. 1 )  SZ=SQRT < SI ZE*CHNLW/3. 14159) 

IF( IDIM.EQ.2)  SZ=SIZE 
XCENT=X+(10.*SZ) 

CALL  JHHDC(XCENT,IAC,SIGY,SIGZ) 

TMX=(X+(4.5*SIGY))/UWIND 
TMN=(X-(3.5*SIGY))/UWIND 
IF (TMN.LE.0.0)  TMN=1.0 
DT=<TMX-TMN)/19. 

DO  10  1=1,20 

AT  < I )=FL0AT ( 1-1 )tDT+TMN 

IF(INC.EQ.l)  AT( I )  =  (X/UWIND)  +  1 .0 

IF( INC. EQ.O)  CALL  VAPC(X»Y,Z»  ATd ) , TNG, H, UWIND t 1AC, IDIM, SIZE, 
4CHNLU,  ACd ,  1 ) ) 

IF ( INC.EQ.l )  CALL  CONVAP(X, Y, Z,AT(I) ,H, FLOW, UWIND, IAC,IDIM, SIZE, 
tCHNLUt  ACdrl) ) 

IF (INC.EQ.1)  GO  TO  11 

10  CONTINUE 

WRITE  TABLE  OF  CONCENTRATION  VS  TIME  AT  USER  SPECIFIED  POINT. 

11  1=1 

175  ATM=AT(I)/60. 

ATH*ATM/60, 

IF(AC( I > 1 ) .6T.0.0)  CALL  TOXIC< AC<I * 1 ) , If AMrXCPPM) 
IF(ACdfl).GT.O.O)  CALL  TOXIC  (AC  (1,1)  ,0r  AM.XCMQL) 

IF(XCPPM,GT. 1000000.)  XCPPM«1000000. 

IF(XCMOL .GT . 100. )  XCM0L=100. 

IF(IC2PF. NE.O. AND. IC2PF.NE.1)  GO  TO  28 
GO  TO  29 
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28  CONTINUE 
CALL  PAGER( 1 ) 

URITE(LP ,35)  ATM. ATH.XCPPM.XCMOL 

29  CONTINUE 

IF ( INC *NE. 1 )  GO  TO  30 
CALL  PAGER(7) 

SORTM=(SORDRN+(X/UWIND) )/60. 

CALL  PAGER(7) 

WRITE (6,26)  SORTM 

30  CONTINUE 

IF (INC.EQ.l)  GO  TO  32 

1=1  +  1 

IF(I.EQ.21)  GO  TO  32 
GO  TO  175 
32  CALL  PAGER (4) 

WRITE(LPi31 ) 

CALL  FRCL(2012,X,IS,IR) 

CALL  FRCL(2013,Y»IS»IR) 

CALL  FRCL(2014,Z» IS, IR) 

IF < I W . GE « 2 )  CALL  PAGER(4) 

IF< INC.EQ.l. AND. IW.EQ. 2)  WRITE(LP,94) 

IF (INC.EQ.l. AND. IW.EO. 3)  WRITE  CLP, 96) 

86  CONTINUE 

IF(ICIPF.EQ.O)  GO  TO  40 
IF(IClPF.EQ.l)  GO  TO  14 

CALCULATE  DATA  FOR  PLOT  OF  MAXIHUM  QROUNDLEVEL  CONCENTRATION 
IN  DOWNWIND  CENTERLINE  DIRECTION  VS  TIME  AND  DISTANCE 
ZZ=0. 

YY=0. 

IF(INC.EQ.l)  XMN=SIZE+1 . 0 
IF (INC.EQ.l. AND.XMN.LT. 305.)  XMN=305. 

IF (INC.EQ. 1)  GO  TO  88 
Ah T= TNG/908000 . 

XMN=(2.**AL0G10(AMT>)*1905. 

IF (XMN.LT .SIZE)  XMN=SIZE 
88  DX=ABS((XHX-XHN)/19.) 

DO  12  1=1.20 

AX ( I )  =  (FLOAT (1-1  XDXHXHN 
TIM=AX ( I ) /UWIND 

IF(INC.EQ.O)  CALL  VAPC(AX(I).YY.ZZrTIM.TMG,H.UWIND.IAC.IDIM.SIZE. 
♦CHNLWf AC (1.2)) 

IF (INC.EQ.l)  CALL  CONVAP( AX( I ) .YY.ZZ.TIM.H.F^OW.UWIND. IAC. IDIM.SIZ 
*E.CHNLW»AC( I .2) )  * 

IF ( AC< I . 2) . GE .C2X)C2X=AC< I .2) 

12  CONTINUE 
14  CONTINUE 


WRITE  PLOT  FILE 


DO  15  1=1.2 

IFd.EQ.l. AND. INC.EQ.l)  GO  TO  15 
IF ( IC1PF . EQ.2. AND. I , EQ, 1 )  DO  TO  15 
IF( IC1PF . EQ. 1 . AND . I . EQ . 2 )  GO  TO  15 
DO  13  11=1.20 

IFd.EQ.l)  ASAV(II)=AT(II)/60. 

IF  ( I  .EQ.2)  ASAVdl  )=AX(II  )/100, 

IF(AC(II.I)  .GT.l.)  ACdl » I )  =  1 .0 

IF(ACdl.I)  .GT.O.O)  CALL  TOXIC( AC(  II.  I )  .0. AM.  ASAVC( II ) ) 

I F <  ASA VC (I I ) . GT . 100 . )  ASAVC ( 1 1 )  =  100 . 

13  CONTINUE 

OIF(I.EG.l)  CALL  PLTLP ( PTITL. ASAV. ASAVC, 20. XTI TL 1 .YTITL1 . 1 .60 . » 
1  XTITL2) 

DIV=0.6*UUIND 

0IF(I.EQ.2)  CALL  PLTLP(PTIT  . ASAV. ASAVC, 20.XTITL3. YTITL2, 1 .DIV, 
1  XTITL4) 

CALL  PAGER<4> 

WRITE ( 6 , 16) 

15  CONTINUE 
C 

C . SET  UP  OFF-LINE  PLOT 

PLTYP=3 
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40  CONTINUE 

99  RETURN 

16  FORMAT ( //35X , 65H*****  RESULTS  IN  UNITS  OF  MOLE  PERCENT  MULTIPLIED 
*BY  10.000  *m*/35X»40H**m  GIVE  ANSWERS  IN  UNITS  OF  PPM  »***) 

20  FORMAT ( 4X.4HTIME. 9X»4HTIME,8X,8HVAP  C0NC,5X,BHVAP  CONC) 

25  F0RMAT(3X,6H(MINS>.7X,6H(  HRS) , 9X,5H(PPM) »7X»7H(M0L  P) / ) 

26  FORMAT <//60H  THE  DISCHARGE  IS  CONTINUOUS.  THE  STEADY-STATE  CONCENT 
1  RATION/  40H  WILL  THEREFORE  AVERAGE  THAT  SHOWN  UNTIL. F7.1.14H  MINUT 
♦ES  AFTER/21H  THE  DISCHARGE  STOPS.//) 

31  FORMAT (//45N  THE  LOCATION  COORDINATES  FOR  THIS  TABLE  ARE-/) 

35  F0RMAT(lX.E10.3»3XfE10,3»3X»E10.3.3X»E10,3) 

940F0Pf1AT(//lX.63H#***  THIS  TABLE  REPLACES  THE  PLOT  OF  CONCENTRATION 
1VS  TIME  ****/lX.63Hm»  REQUESTED  IN  ORDER  TO  SAVE  COMPUTATION  TIH 
%  %  %  %  '• 

950F0RMAT  (56H  TABLE  OF  CONCENTRATION  VS  TIME  AT  USER  SPECIFIED  POIN 

IT//) 

?60F0RMAT(//lX.63Hm*  SINCE  A  PLOT  OF  CONCENTRATION  VS  TIME  WOULD  NO 
IT  SHOW  *$**/lX.63H*m  ADDITIONAL  INFORMATION,  ONE  IS  NOT  PRODUCE 
2D.  ****) 

1000F0PMAT(/5Xf56H***  THE  MAXIMUH  EXTENT  OF  FLAMMABLE  VAPOR  HAZARD  IS 
1ZER0/9X.56HBECAUSE  THE  LOWER  FLAMMABLE  LIMIT  CONCENTRATION  IS  ZERO 
2. ) 

1100FGRMAT(/5X,52H*t*  THE  MAXIMUM  EXTENT  OF  TOXIC  VAPOR  HAZARD  IS  ZERO 
1/9X.52HBECAUSE  THE  LOWER  TOXIC  LIMIT  CONCENTRATION  IS  ZERO.) 

1200F0RrtAT(/SX»62H**#  THE  MINIMUM  ANSWER  HACS  CAN  GIVE  IS  305  CM  OR  10 
1  FEET  WHEN/9X, 61HTHE  LOWER  FLAMMABLE  LIMIT  CONCENTRATION  IS  GREATE 
2R  THAN  ZERO.) 

1300r0F:HAT(/5X,62H***  THE  MINIMUM  ANSWER  HACS  CAN  GIVE  IS  305  CM  OR  10 
1  FEET  WHEN/9X, 57HTHE  LOWER  TOXIC  LIMIT  CONCENTRATION  IS  GREATER  TH 
2AN  ZERO.) 

END 

SUBROUTINE  M0DC2 

SUBROUTINE  M0DC2  OBTAINS  THE  NECESSARY  DATA  TO  EXECUTE  ROUTINE 
IVAF’C  FOR  INSTANTANEOUS  SPILLS  OR  IVAPCN  FOR  CONTINUOUS  SPILLS. 

THESE  ROUTINES,  GIVEN  HAZARDOUS  VAPOR  CONCENTRATIONS,  CALCULATE 
THU  ARRIVAL  TIME  OF  A  HAZARDOUS  CONCENTRATION,  ITS  DURATION,  AND 
ITS  WIDTH  IN  THE  CLOUD  OR  PLUME. 

DIMENSION  ASW< 20) , AT (20) » AX ( 20 ) » ADRN(20) ,110(20) 

DATA  M0D/4H  C2  / 

5  CONTINUE 
IR  =  0 
13=6 
LF=6 

OBTAIN  NECESSARY  DATA  ITEMS 


CALL  BEGPR(MOD) 

CALL  IRCL < 2061 , INC , IS , IR> 

CALL  FRCL(1002,AM,IS,IR) 

CALL  FRCL (2012, X , IS, IR > 

CALL  FRCL (2013, Y, IS, IR) 

CALL  FRCL ( 2015.H, IS, IR) 

CALL  FRCL( 2016 .UWIND, IS, IR) 

CALL  IRCL(2017,IAC,IS,IR) 

CALL  IRCL ( 2018, IDIM, IS, IR) 

CALL  FRCL (20 19, SIZE , IS, IR) 

IF(IDIM.EQ.l)  CALL  FRCH2020.CHNLW, IS, IR) 
CALL  FRCL < 2032, CTOX, IS, IR) 

CALL  FRCL(2033,CFIR, IS, IR) 

IF(INC.EQ.O)  CALL  FRCL(4001 , TMG, IS.IR) 

IF ( INC.EQ.l )  CALL  FRCL(4044,FL0W»IS,IR) 
IF( INC.EQ. 1 )  CALL  FRCL(4045,SGRDRN,IS,IR> 
CALL  IRCL (3005, IC2PF , IS, IR) 

IF(IC2PF.E0.0>  GO  TO  1 
IF (IC2PF .EQ.2)  GO  TO  1 
CALL  FRCL(2035, XMX, IS, IR) 

1  CALL  EPRNKMOD,  IS,  IR,  ID 
IF ( IL.EQ. 1 )  GO  TO  99 
IF( IL .EQ.2)  GO  TO  5 
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CALL  IVAPC  OR  IVAPCN  AS  APPROPRIATE  FOR  THE  HAZARD  CONCENTRATIONS. 


IFIR=1 

IIT0X=0 

IF(CTOX.GT.O.O)  IIT0X=1 

IF(CFIR.GT.O.O)  IFIR=0 

IF(IITOX.EQ.l)  CALL  ITOX(CTOX.AM.IITOX.C) 

IF ( I ITOX • EQ *  1 )  CTOX*C 

IF(IFIR.EQ.O)  CALL  ITOX(CFIR. AM. IFIRi C) 

IF (IFIR.EQ.O)  CFIR=C 

DO  10  ICNT=1 *2 

IF(ICNT.EQ.l)  C=CT0X 

IF (ICNT .EQ.2)  C=CFIR 

IF (IITOX.EQ.O. AND. I CNT.EQ.l )  GO  TO  10 

IFdFIR.EQ.l. AND. ICNT. EQ.2)  GO  TO  10 

IF (INC.EQ.O)  CALL  IVAPC<TMG»UWIND»HfC.X»Y.IAC.IDIM»SU»SIZE»CHNLUf 
1TIME.DURN.I0) 

IF ( INC .EQ. 1 )  CALL  1VAPCN(X.Y.0.0»H»S0RDRN»FL0U»SIZE»IDIM»CHNLW,UUI 
INDr IACfC.SU. TIME >  DURN) 

IF(TIME.LT.O.O)  TIME=0.0 


UPDATE  DATA  BASE 


CALL  OUTPR(MOD) 

IF ( ICNT .EQ.2)  GO  TO  9 
CALL  PAGER(2) 

WRITE(LP.IOO) 

CALL  PAGER(2) 

WRITE ( 6 » 1 20 ) 

CALL  FSVMOll »SUf 4) 

CALL  FSV(4012»DURN.4) 

CALL  FSV(4013»TINE.4) 

GO  TO  10 
9  CALL  PAGER(2) 

URITE(LP.llO) 

CALL  PAGER<2) 

WRITE<LP»120) 

CALL  FSV(4065.SU .4) 

CALL  FSV(4066»DURNi4) 

CALL  FSV(4067iTIME»4) 

10  CONTINUE 

IF (IITOX.EQ.O)  CALL  PAGER (4) 
IF(IITOX.EQ.O)  WRITE(LP. 150) 
IF (IFIR.EQ.l)  CALL  PAGER<4) 
IFdFIR.EQ.l)  URITE(LP.  160) 
CALL  ENDPR(MOD) 


CALCULATE  DATA  FOR  AND  WRITE  TABLE  OF  HALF  UIDTHS.  ARRIVAL  TIMES. 
AND  HAZARD  DURATIONS  IF  REQUESTED. 


IF ( IC2PF.EQ.0)  GO  TO  99 
IF( IC2PF ,EQ.2)  GO  TO  99 
IF(INC.EQ.l)  XMN=10.*12.*2.54 
IF(INC.EQ.l)  GO  TO  20 
AMT=TMG/908000. 
XMN=(2.**ALOG10(AMT))*1905. 

20  DX=(XMX-XMN)/19. 

DX=ABS(DX) 

DO  50  ICNT*1 .2 
IU=0 

IF (IITOX.EQ.O. AND .ICNT . EQ. 1 )  IW=1 
IF(IU.EQ.O)  GO  TO  22 
CALL  PAGER(4) 

WRITE(LP. 26) 

GO  TO  50 

IFdFIR.EQ.l. AND. ICNT. EQ.2)  IW>2 
IFdU.NE .2)  GO  TO  24 
CALL  PAGER(4) 


22 


WRITE(LP.28) 
GO  TO  99 
24  IF(ICNT.EQ.l) 


C*CTOX 


IF ( ICNT .EQ.2)  C=CFIR 
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CALL  PAGER (0) 

CALL  PAGER(7) 

IF(ICNT.EQ.l)  WRITE ( 6 » 38 ) 

IF <  ICNT .EQ.2)  WRITE(6»39) 

WRITE<6»41) 

WRITE<  6,42) 

DO  30  1=1,20 
AX<I)=XMN+FL0AT(I-1)*DX 

IF( INC.EQ.O)  CALL  IVAPC(TMG»UWIND»H»C, AX<I ) , Y, IAC, IDIM, ASWII ) ,SIZE 
1 ,CHHLW, AT ( I ) » ADRN( I ) » II0( I ) ) 

IF(IHC.EQ.l)  CALL  IVAPCN(AXCI) ,Y,0.0»H,S0RDRN, FLOW, SIZE, IDIM»CHNLW 

1 , UWIND, IAC,C, ASW( I) , AT( I ) , ADRN( I ) ) 

IF < AT < I > »LT .0.0)  AT(I)=0.0 
DISH=AX(I)/100. 

DISFT=AX(I)/(2. 54*12.) 

ATIM=AT(I)/AO. 

SWM=ASW( I >/100. 

SUFT=ASU(I)/(2. 54*12.) 

DRNMN= ADRN ( I ) / 60 . 

CALL  PAGER(l) 

WRITE<6,43>  DISM»DISFT> ATIM»SWM»SWFT»DRNMN 
30  CONTINUE 
YM=Y/iOO. 

YFT=Y/(2. 54*12.) 

CALL  PAGER (3) 

WRITE(&»44)  YM» YFT 
CALL  PAGER (2 5 
WRITE(6,45) 

CALL  PAGER<2) 

WRITE(A,46) 

50  CONTINUE 
99  RETURN 

2AOFORMAT(//1X»50H****  TOXIC  VAPOR  CLOUD  HAZARD  TABLE  NOT  GIVEN  ****/ 
11X,50H**«*  BECAUSE  2032  LOWER  TOXIC  LIMIT  IS  ZERO.  ***«) 

280FORMAT ( //1X.54H****  FLAMMABLE  VAPOR  CLOUD  HAZARD  TABLE  NOT  GIVEN  * 
1***/1X,54H****  BECAUSE  2033  LOWER  FLAMMABLE  LIMIT  IS  ZERO.  **»*) 

38  FORMAT </20X,41HT0XIC  VAPOR  CLOUD  HAZARD  TABLE  -  MODEL  C2//) 

39  FORMAT </18X,45HFLAMMABLE  VAPOR  CLOUD  HAZARD  TABLE  -  MODEL  C2//) 

41  FORMAT ( IX, 10HX-DISTANCE»3X» 1 OHX-D I STANCE ,3X , 10HARRIV  TIME,3X, 12H1/ 
12  HAZ  Z0NE,3X,l2Hl/2  HAZ  Z0NE,3X,8HDURATI0N> 

42  FORMAT <2X,8H( METERS) , 4X,6H(FEET) ,6X» PH (MINUTES ) ,5X»BH (METERS) »8X»6 
1H(FEET) , AX, 9H( MINUTES)/) 

43  FORMAT(1X,G10.4,3X«G10.4,3X,G10.4,4X,G10.4,5X,G10.4,4X»G10.4) 

44  FORMAT (//15X, 19HTHE  Y  COORDINATE  =  ,G10.4,5H  M  =  ,G10.4,4H  FT.) 

45  FORMAT f 15X, 41HTHE  Z  COORDINATE  IS  FIXED  AT  GRDUNDLEVEL./) 

460F0RMAT  U5X,62HAN  ARRIVAL  TIME,  HALF  WIDTH,  AND  DURATION  OF  0.0  IN 

1DICATES  THE/15X,5AHHAZARD0US  CONCENTRATION  NEVER  REACHES  THE  GIVEN 
2L0CATI0N.) 

100  FORMAT ( IX, 28HF0R  THE  TOXIC  CONCENTRATION./) 

110  FORMAT ( 1X.44HF0R  THE  LOWER  FLAMMABLE  LIMIT  CONCENTRATION./) 

120  FORMAT (1X»28HAT  THE  USER  SPECIFIED  POINT./) 

1500F0RMAT ( /5X , 52H*f*  RESULTS  FOR  THE  TOXIC  VAPOR  HAZARD  ARE  NOT  GIVEN 
1/9X,52HBECAUSE  THE  LOWER  TOXIC  LIMIT  CONCENTRATION  IS  ZERO./) 
16COFORMAT(/5X,56H**f  RESULTS  FOR  THE  FLAMMABLE  VAPOR  HAZARD  ARE  NOT  G 
1IVEN/9X»56HBECAUSE  THE  LOWER  FLAMMABLE  LIMIT  CONCENTRATION  IS  ZERO 

2. /) 

END 

SUBROUTINE  MODG 

SUBROUTINE  MODG  CALLS  THE  VAPOR  DISPERSION  ROUTINES  OF  MODEL  C 
FOR  SPILLS  OF  LIGHTER-THAN-WATER,  INSOLUBLE  LIQUIDS  WHICH  HAVE 
BOILING  POINTS  LESS  THAN  NORMAL  AMBIENT  TEMPERATURES.  IF  THE 
SPILL  IS  INSTANTANEOUS,  IT  FIRST  SUMS  THE  WEIGHT  OF  GAS  WHICH 
ESCAPED  FROM  A  TANK  WITH  THE  WEIGHT  OF  LIQUID  WHICH  ESCAPED. 

THIS  SUM  IS  UTILIZED  IN  SUBSEQUENT  MODEL  C  CALCULATIONS. 

LP=6 

CALL  PAGER<5) 

WRITE(LP,100) 


CALL  1RCL(2061 » ISPT , IS , IR) 
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IF ( ISPT.EQ. 1 )  GO  TO  10 
CALL  FRCL<4001*TMG*IS*1R> 

CALL  FRCL<4002*TML*IS*IR) 

TMG=TMG+THL 
CALL  PAGER (2) 

MRITE(LP»102) 

CALL  FSV<4001.TMG*A) 

10  CALL  M0DC1 
CALL  M0DC2 
CALL  PAGER<2> 

URITE(LP.lOl) 

RETURN 

100  FORMAT C///55H  MODEL  G  IS  FUNCTIONALLY  REPLACED  BY  MODELS  Cl  AND  C2 
1.  /) 

101  FORMAT ( 18H  MODEL  G  EXECUTED*/) 

102  FORMAT ( 72H  FOR  MODEL  G.  LET  HASS  OF  GAS  BE  TOTAL  OF  LIQUID  AND  GAS 
tMASSES  RELEASED./) 

END 

SUBROUTINE  MODJ 

SUBROUTINE  MODJ  CALLS  THE  VAPOR  DISPERSION  ROUTINES  OF  MODEL  C 
FOR  SPILLS  OF  HE AVIER-THAN- WATER*  INSOLUBLE  LIQUIDS  WHICH  HAVE 
BOILING  POINTS  LESS  THAN  NORMAL  AMBIENT  TEMPERATURES.  IF  THE 
SPILL  IS  INSTANTANEOUS*  IT  FIRST  SUMS  THE  WEIGHT  OF  GAS  WHICH 
ESCAPED  FROM  A  TANK  WITH  THE  WEIGHT  OF  LIQUID  WHICH  ESCAPED. 

THIS  SUM  IS  UTILIZED  IN  SUBSEQUENT  MODEL  C  CALCULATIONS. 


LP-6 

CALL  PAGER (5) 

WRITE (LP* 100 ) 

OBTAIN  FROM  THE  EXECUTION  OF  MODEL  A  TOTAL  MASS  GAS  AND  TOTAL 
MASS  LIQUID  FOR  USE  IN  MODELS  Cl  AND  C2 

CALL  IRCU2061.ISPT.IS.IR) 

IF < ISPT.EQ, 1 )  GO  TO  10 
CALL  FRCL(4001,TMG*IS»IR) 

CALL  FRCLC4002.TML.IS.IR) 

TMG=TMG+TML 
CALL  PAGER <2) 

URITECLP* 102) 

CALL  FSV<  4001 *TMG*6) 

10  CALL  M0DC1 
CALL  M0DC2 
CALL  PAGERC2) 

UPITE(LP* 101 ) 

RETURN 

100  FORMAT (///54H  MODEL  J  IS  FUNCTIONALLY  REPLACED  BY  MODELS  Cl  AND  C2 
l./> 

101  FORMAT ( 18H  MODEL  J  EXECUTED,/) 

1020F0RMAT  (73H  FOR  MODEL  J*  LET  MASS  OF  GAS  BE  TOTAL  OF  LIQUID  AND  GA 
IS  MASSES  RELEASED./) 

END 

SUBROUTINE  MODN 

SUBROUTINE  MODN  CALLS  THE  VAPOR  DISPERSION  ROUTINES  OF  MODEL  C 
FOR  SPILLS  OF  SOLUBLE  LIQUIDS  WITH  BOILING  POINTS  LESS  THAN 
NORMAL  AMBIENT  TEMPERATURES,  IT  IS  USUALLY  PRECEDED  BY  THE 
EXECUTION  OF  MODK.  IF  MODK  HAS  BEEN  ABLE  TO  COMPUTE  THE  AMOUNTS 
OF  CHEMICAL  WHICH  DISSOLVE  AND  EVOLVE  AS  VAPOR.  MODN  DIRECTLY 
CALLS  MODEL  C  AFTER  ASUMING  THE  VAPOR  SOURCE  IS  CIRCULAR  AND 
CALCULATING  A  POOL  RADIUS.  IF  MODK  HAS  NOT  BEEN  ABLE  TO  COMPUTE 
SPECIFIC  AMOUNT  OF  CHEMICAL  WHICH  EVOLVES  AS  VAPOR.  MODN 
SUMS  THE  WEIGHT  OF  GAS  RELEASED  FROM  THE  TANK  (  IF  ANY  ) 

WITH  SOME  USER  SPECIFED  FRACTION  OF  THE  LIQUID  WHICH  IS 
RELEASED  FROM  THE  TANK,  THIS  SUM  IS  THEN  UTILIZED  IN 
SUBSEQUENT  MODEL  C  CALCULATIONS,  IF  THE  RELEASE  TAKES  PLACE 
AT  A  DEPTH  GREATER  THAN  10  FEET  UNDERWATER  OR  THE  DENSITY  OF  THE 
CHEMICAL  IS  GREATER  THAN  THAT  OF  WATER*  MODN  ASSUMES  THE  POOL 
RADIUS  IS  THE  VOLUME  OF  THE  CHEMICAL  RELEASED  RAISED  TO  THE 
ONE-THIRD  POWER,  IT  THE  RELEASE  IS  AT  A  DEPTH  LESS  THAN  10  FEET 
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UNDERWATER  AND  THE  DENSITY  OF  THE  CHEMICAL  IS  LESS  THAN  THAT  OF 
WATER?  MODN  ASSUMES  THE  POOL  RADIUS  IS  12  TIMES  THE  VOLUME  OF 
CHEMICAL  RELEASED  RAISED  TO  THE  ONE-THIRD  POWER. 

DATA  M0D/4H  N  / 

1  CONTINUE 
LP=6 
1S=A 

^ALL  BEGPR(MOD) 

CALL  FRCLU021.DENL.IS.IR) 

CALL  FRCL(2021.H»IS»IR) 

CALL  FRCL(4003'V0L.IS»IR) 

IF(VOL.EQ.O.O)  CALL  FRCLM002.TML.IS.IR) 

IF<V0L.EQ.0.0)  VOL*TML/DENL 
CALL  IRCL<2084'IFLAGf IS'IR) 

IF < IFLAG.EO. 1 )  CALL  FRCLU001.TMG.IS.IR) 

IF ( IFLAG. EQ . 1 )  CALL  FRCLI4002.TML.IS. IR> 

IF( IFLAG.EO . 1 )  CALL  FRCL(2085.PERC.IS»IR) 

CALL  EPRNT(MOD'IS.IR.IL) 

IF(IL.EQ.l)  GO  TO  ?? 

IF ( IL .EQ«2>  GO  TO  1 
CALL  PAGER<2) 

WRITE (LP 1 1 0 ) 

IF ( IFLAG .NE . 1 )  GO  TO  5 
TMG=TrtG+(PERC*TML) 

CALL  PAGERI4) 

WRITE(LP»20)  PERC 
CALL  FSV(40Q1 »TMG»6) 
r,  CALL  PAGER(3) 

WRIT£(LP.30> 

CALL  ISVC2018.2.4) 

GIZE=V0L**0. 333333 

IF (H .LT . 304.8. AND. DENL.LT ,1.0)  SIZE=12.tV0Lt*0. 333333 
CALL  FSV(2019.SIZE>2) 

CALL  M0DC1 
CALL  M0DC2 
CALL  ENDPR(MOD) 

99  RETURN 

10  F0RMATI/54H  MODEL  N  IS  FUNCTIONALLY  REPLACED  BY  MODELS  Cl  AND  C2.) 
20  FORMAT </63H  FOR  MODEL  N»  IT  IS  ASSUMED  THAT  THE  MASS  OF  GAS  EVOLVE 
ID  IS  THE/26H  MASS  OF  GAS  EVOLVED  PLUS  .F&.3.1X.34HTIMES  THE  MASS  0 
IF  LIQUID  RELEASED./) 

30  FORMAT </81H  THE  FOLLOWING  VAPOR  SOURCE  PARAMETERS  ARE  ESTIMATED  FO 
1R  USE  BY  MODELS  Ct  AND  C2./1 
END 

SUBROUTINE  MODS 

SUBROUTINE  MODS  CALLS  THE  VAPOR  DISPERSION  ROUTINES  OF  MODEL  C 
FOR  SPILLS  OF  SOLUBLE  LIQUIDS  WITH  HIGH  VAPOR  PRESSURES. 


LP=4 

CALL  PAGERI2) 

WRITE(LP'IO) 

CALL  M0DC1 
CALL  M0DC2 

10  FORMAT ( /54H  MODEL  S  IS  FUNCTIONALLY  REPLACED  BY  MODELS  Cl  AND  C2.) 
RETURN 
END 

SUBROUTINE  MODW 

SUBROUTINE  MODW  CALLS  THE  VAPOR  DISPERSION  ROUTINES  OF  MODEL  C 
FOR  SPILLS  OF  LIGHTER-THAN-WATER.  INSOLUBLE  LIQUIDS  WHICH  ARE 
VOLATILE  AT  NORMAL  AMBIENT  TEMPERATURES.  IF  THE  VAPOR  RELEASE  IS 
ESTIMATED  TO  BE  BEST  REPRESENTED  AS  BEING  INSTANTANEOUS'  IT 
COMPUTES  THE  AMOUNT  OF  LIQUID  WHICH  HAS  EVAPORATED  UP  TO  THE  USER 
SPECIFIED  TIME  OR  THE  TIME  AT  WHICH  EVAPORATION  STOPS  AND  PROVIDES 
THIS  VALUE  TO  MODEL  C.  FOR  CONTINUOUS  RELEASES.  THE  MODEL  C 
ROUTINES  USE  THE  VAPOR  EVOLUTION  RATES  CONFUTED  BY  MODEL  V. 

MODW  ALSO  TRANSFERS  THE  POOL  SIZE  COMPUTED  BY  MODEL  V  FROM  FIELD 
NUMBER  4027  TO  2019. 
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LP=6 

CALL  PAGER<5> 

WRITE(LP» 100) 

CALL  IRCL  <2061 » ISPT » IS.IR) 

IF(lSPT.EQ.l)  GO  TO  10 
CALL  FRCL( 1004.DENL. IS. IR> 

CALL  FRCL (4026. VOL. IS» IR) 

CALL  FRCL (4003. VOL I r IS » IR ) 

VAP0R=( VDL]-V0L)*DENL 
CALL  PAGER(3) 

URITE(LP» 102) 

CALL  FSV( 4001 .VAPOR. 6) 

OBTAIN  FROM  DATA  BASE  FOR  USE  IN  MODEL  Cl  AND  C2  THE  SIZE  OF 
SPILL  AS  CALCULATED  BY  MODEL  V 


10  CALL  PAGER<2) 

WRITE(LP.200) 

CALL  FRCL ( 4027. S» IS.IR) 

CALL  FSV(2019»S.6) 

CALL  M0DC1 
CALL  M0DC2 
WRITE (LP» 101 ) 

RETURN 

100  FORMAT <///54H  MODEL  U  IS  FUNCTIONALLY  REPLACED  BY  MODELS  Cl  AND  C2 

1./) 

101  FORMAT ( 18H  MODEL  U  EXECUTED./) 

102  FORMAT < 1X.57HF0R  MODEL  U>  LET  WEIGHT  OF  VAPOR  WHICH  IS  ESTIMATED  T 
10  BE/1X.58HRELEASED  INSTANTANEOUSLY  BE  THE  WEIGHT  WHICH  HAS  VAPORI 
2ZED/1X.53HUP  TO  TIME  4030  EVP  TIM  HVPL  GIVEN  IN  MODEL  V  OUTPUT.) 

200  FORMAT (44H  USE  SIZE  OF  SPILL  AS  CALCULATED  BY  MODEL  V./) 

END 

SUBROUTINE  VAPCQ.Y.Z.T.TMG.H.UUIND.IAC.  IDIM.SIZE.CHNLW.C) 

*********************************************************************** 


***  VAPOR  DISPERSION  FOR  MODEL  C  ******* 

***  THIS  SUBROUTINE  CALCULATES  THE  DOWNWIND  DISPERSION  OF  VAPOR  CAUSE 
BY  A  VAPOR  LEAK  FROM  A  TANK  OR  VAPOR  LIBERATION  FROM  A  POOL  OF  LI 
IT  IS  ASSUMED  THAT  ALL  THE  GAS  COMES  OUT  FROM  A  POINT  SOURCE.  IN 
OF  A  PUFF  (INSTANTANEOUSLY).  THIS  POINT  IS  ASSUMED  TO  BE  LOCATED 
POSITION  OF  THE  HOLE  IN  THE  TANK  OR  FIVE  DIAMETERS  BEHIND  THE  POO 
THE  CASE  MAY  BE. 


********** 


***  UWIND 
***  IAC 


***  CHNLW 

********** 
***  C 


INPUT  ARGUMENTS  ********** 

=  WIND  DIRECTION  CO-ORDINATE  CMS 

=  CROSS  WIND  CO-ORDINATE  CMS 

=  HEIGHT  COORDINATE  CMS 

=  TIME  AFTER  THE  SPILL  /LEAK  AT  WHICH  THE  CONCN  IS  DESIRE 
=  TOTAL  MASS  OF  THE  GAS  RELEASED  GMS 

=  HEIGHT  OF  THE  CENTER  LINE  OF  THE  HOLE  ABOVE  GROUND 
=  WIND  VELOCITY  CM/SEC 

=  ATMOSPERIC  CONDITION  AS  DEFINED  IN  SUBROUTINE  JHHDC 
=  DIMENSION  OF  SPILL  <1  IF  ONE  DIMENSIONAL. 2  IF  RADIAL) 

=  MAXIMUM  RADIUS/LENGTH  OF  POOL  CMS 

=  CHANNEL  WIDTH  (REQUIRED  FOR  IDIM«1  ONLY)  CMS 
OUTPUT  ARGUMENTS  ********** 

*  VAPOR  CONCENTRATION  GMS/CM**3 


C****************  ***********  t  **********  t******************************** 

c 

PI*3. 14159256 
IF ( IDIM-i )  10.10.20 
10  A=SIZE*CHNLW 
SIZE*SQRT(A/PI ) 

20  FACT«10.*SIZE 
XC=UWIND*T 
XC*XC+FACT 

CALL  JHHDC(XC. IAC.SIGY.SIGZ) 

SIGX*SIGY 

Cl»(TMG/( (2  »*PI)**1 »5*SIGX*SIGY*SIGZ) ) 
A1«EXP(-(Z-H)**2/(2.»SIGZ**2) ) 
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A2=EXP(-(Z+H)**2/(2.*SIGZ**2)) 

C3=C1*A2 

C2=C1*A1 

Q[i=C?+C3 

C=C0lEXP(-<X-UWINDtm*2/(2.*SIGXtt2>)*EXP<-Yt*2/(2.*SIGY**2)> 

IF ( IDIM-1 )  30.30.40 
30  SIZE=A/CHHLW 
40  RETURN 
END 

GVERLAY(6»0) 

FROGRAM  MODD 

MODD  IS  USED  TO  CALCULATE  THE  SIZE  OF  A  POOL  AS  A  FUNCTION  OF 
TIME  AND  THE  TINE  IT  HILL  TAKE  FOR  THE  POOL  TO  COMPLETELY 
VAPORIZE.  IT  IS  USED  FOR  LIGHTER-THAN-UATER*  INSOLUBLE  CHEMICALS 
WITH  A  BOILING  POINT  LESS  THAN  THE  AMBIENT  TEMPERATURE. 

C0MN0N/C/PLTYP»XBX(150) 

INTEGER  PLTYP 

DIMENSION  SIZ (20) *  TIM (20) »ASAV(20) 

DIMENSION  PTITL<  6)  »XTITL(6) .XTITL1C6) »YTITL(6) 

EQUIVALENCE  (XBX( 1 > . TIM(1 ) ) . (XBX<41 ) .SIZ<1 ) > , <XBX(21 > .ASAV(l) ) 
REAL  KC.KHIC 

ODATA  (PTITL  (1 5 . 1  =  1 »6>/8HP00L  RAD.8HIUS/LENG. 8HTH  VS  TI» 

18HME  -  MOD  »8HEL  D  »1H  / 

ODATA  (XTITL  (I ) » 1=1 .6 ) /8HELAPSED  .8HTIME. . . . »8H . . 

18H . »8H . (.8HSEC0NDS)/ 

ODATA  (XTITLl(I) .  1  =  1 .4 ) /8HELAPSED  .8HTIME, . . . »8H . . 

18H . »8H . ( » 8HMINUTES) / 

ODATA  ( YTITL  < I ) . 1  =  1 .6) /8HP00L  RAD»8HIUS  .8H0R  LENGT . 

18HH  .8H(METERS).1H  / 

DATA  M0D/4H  D  / 

1  CONTINUE 

CALL  TRACE (0.6.0) 

IR-0 

IS=6 

LP=6 

OBTAIN  NECESSARY  DATA  ITEMS 

CALL  BEGPR(MOD) 

CALL  IRCL(2060»ISPT .IS.IR) 

CALL  FRCL(1003.TCRY, IS.IR) 

IF(ISPT.EQ.O)  CALL  FRCL( 1005.VISL. IS.IR) 

CALL  FRCL(1014.HLATL. IS.IR) 

CALL  FRCL(1021.DENL. IS.IR) 

IF(DENL-I.O)  40.30.30 
30  CONTINUE 
CALL  PAGER (4 ) 

WRITE(LP.IOO) 

DENL=0.99 
40  CONTINUE 

IF(ISPT.EO.l)  CALL  FRCL(2008.DIA. IS.IR) 

IF(ISPT.EQ.O)  CALL  FRCL(2020.CHNLH. IS.IR) 

IF(ISPT.EQ.O)  CALL  IRCL(2022.I0.IS.IR) 

CALL  FRCL(2023.TINF. IS.IR) 

CALL  COMPQ(TINF.TCRY.Q) 

CALL  FSV(2024»Q»4) 

CALL  FRCL(2024.0. IS.IR) 

IF(ISPT.EO.l)  CALL  FRCL(2026. TIME. IS.IR) 

IF(ISPT.EQ.l)  CALL  FRCL(2059.HGT. IS.IR) 

IF(ISPT.EO.O)  CALL  FRCL(4003. VI .IS.IR) 

IF(ISPT.EG.O.AND.VI.EQ.O.O)  CALL  FRCU4002.SPAMT. IS.IR) 

IF (ISPT , EO . 0 . AND . VI , EQ . 0 . 0 )  VI=SPAMT/DENL 
IF( ISPT.EO. 1 )  CALL  FRCL ( 4O49.FL0H. IS.IR) 

IF < ISPT .EQ. 1 )  CALL  FRCL ( 4050. ENDTM. IS.IR) 

CALL  IRCL(3006. IP. IS.IR) 

CALL  IRCL(3013.ITAB» IS.IR) 

ICNT=0 

CALL  EPRNT (MOD. IS. IR» IL) 

IF ( IL .EQ. 1 )  GO  TO  99 
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IF(IL.EQ.2)  GO  TO  1 
IF(ISPT.EQ.l)  GO  TO  80 
TIME=10.0 
70  ITC=1 

CALLCRYSP( IDIM. IQ. Q» VI »DENL» VISL.HLATL.TCRY.TINF.CHNLW.TIME. ITC. 
ITOWC .KC.KHIC. VOL. SIZE .SIZMX.TEVAP) 

IF(SIZMX.EQ.O.O)  TIME=TEVAP/2. 

IF(SIZMX.EQ.O.O)  ICNT*ICNT+1 
IF(SIZHX.EQ.O.O.AND.ICNT . EQ.l)  GO  TO  70 
DIAH=2.*SIZMX 

JF(DIAM.LE.CHNLU)  GO  TO  16 

IDIM=1 

ITC=1 

CALL  CRYSP( IDIH.IQ.Q.VI .DENL.VISL.HLATL.TCRY.TINF.CHNLW.TIME. ITC. 
tTOUC.KC.KHIC. VOL .SIZE. SIZMX.TEVAP) 

16  DIAM=2.*SIZMX 

IF(IDIM.EQ.l)  DIAM=SQRT(SIZMX*CHNLW*4./3. 14159) 

SAVSZ=SIZMX 
GO  TO  20 
80  IDIM=2 

CALL  DSPRD ( DENL » DI A » HGT » FLOW .Q.HLATL. TIME. SIZE .TMAX.SIZMX) 
DIAM=2.*SIZMX 

UPDATE  DATA  BASE  WITH  OUTPUT 

20  CONTINUE 

CALL  OUTPR(MOD) 

IF (IDIM.NE.2)  GO  TO  84 
CALL  PAGER(l) 

WRITE(LP»50) 

GO  TO  86 

84  IF(IDIM.NE.l)  GO  TO  86 
CALL  PAGER(l) 

WRITE(LP»60) 

86  CONTINUE 

CALL  ISV(2018»IDIM.4) 

IF ( ISPT.EQ.O)  SIZE=SIZhX 
CALL  FSV(2019»SIZE»4) 

CALL  FRCL(2019»SIZE» IS. IR) 

IF(ISPT.EQ.O)  CALL  FSV(4016.TEVAP.4> 

CALL  FSV(4007.DIAN.4> 

CALL  PAGER (3) 

WRITE (LP. 81 ) 

CALL  FSV(4068. TCRY. 4) 

IND=0 

IF(ISPT.EQ.l)  IND=1 

IF( IND.EQ. 1 )  CALL  ISV(2061.IND.4) 

IF(IND.EQ.l)  CALL  FSV(4044,FL0U»4> 

IF ( IND.EQ. 1 )  CALL  FSV(4045.ENDTM.4> 

IF( ISPT.EQ.O. AND. TEVAP.GE. 600.)  IND=2 
IF(IND.EQ.2)  FLW=VItDENL/TEVAP 
IF ( IND .EQ.2)  CALL  ISV<2061.1.4> 

IF(IND.EQ.2)  CALL  FSV(4044»FLW.4) 

IFUND.EQ.2)  CALL  FSV(4045.TEVAP.4) 

IF ( IND.EQ.O)  CALL  ISV(2061.0.4) 

IF ( IDIM.EQ. 2)  SIZE® .5IDIAM 

IF(IDIM.EQ.l)  SIZE=DIAM*DIAMt3. 14159/(4. *CHNLU) 

CALL  PAGER<2) 

URITE(LP.200) 

SIZE=.707tSIZE 
CALL  FSV(2019.SIZE.6) 

CALL  ENDPR(MOD) 

IF( IP.EQ.O. AND. ITAB.EQ.O)  GO  TO  99 

CALCULATE  DATA  FOR  PLOT  AND/OR  TABLE  OF  POOL  SIZE  VS  TIME 
IF  REQUESTED. 


90 


91  IF(ISPT.EQ.O)  DT-TEVAP/20. 
IF ( ISPT.EQ. 1 )  DT»ENDTM/20. 
IDIM=2 
STM=0.0 
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ITC=1 

DO  10  1=1.20 

T I M  ( I )  =  ( FLOAT ( I  - 1 ) *DT ) +DT 

11  IF(ISPT.EQ.O)  CALL  CRYSPdDIM.IQ.Q.VI  »DENL.VISL»HLATL»TCRY.TINf'« 
*CHNLW.TIM( I ) . ITC.TQWC.KC.KHIC. VOl»SIZ( I ) .SIZMX. TEVP) 

IF(ISPT.EQ.l)  CALL  DSPRD(DENL. DIA.HGT.FLOW. Q.HLATL. TIM( I) . SIZ( I ) > 
<TMAX. SIZMX) 

D=2.*SIZ< I ) 

IF(ISPT.EQ.l)  GO  TO  10 
IF(IDIM.EQ.2.AND.D.GT.CHNLM)  IDIM=1 
IF ( STM » EQ . 0 . 0 . AND .  D .  GT . CHNLW )  ITC=1 
IF (STM.EQ .0.0. AND.D .GT .CHNLW)  STM*TIM(I) 

IFISTH.EQ.DT . AND. ITC.EQ. 1 >  GO  TO  11 
10  CONTINUE 

IF(ISPT.EQ.l)  GO  TO  12 
DIFFR=ABS(S1Z(20)-SAVSZ> 

IF'DIFFR.GT.3.)  SIZ<20)=SAVSZ 
IF(DIFFR.GT ,3. )  STM=TEVAP 

12  CONTINUE 

WRITE  PLOT  FILE 

IF(IP.EQ.O)  GO  TO  19 
DO  15  1=1.20 
15  ASAV(I)=SIZ(I)/100. 

CALL  PLTLP(PTITL .T1M.ASAV.20.XTITL.YTITL. 1 .60. .XTITL1 ) 

IF (STM.EQ. 0,0. OR. I SPT .EQ. 1 )  GO  TO  17 
CALL  PAGER<2) 

WRITE(LP.27)  STM 
17  CONTINUE 


. —SET  UP  OFF-LINE  PLOT 

PLTYP=5 

WRITE  TABLE  OF  SIZE  VS  TIME  IF  REQUESTED. 

IFUTAB.EQ.O)  GO  TO  99 
19  CONTINUE 

CALL  PAGER (0) 

CALL  PAGER(B) 

URITE(LP.21) 

WRITE(LP»22) 

WRITE(LP»23) 

DO  25  1=1.20 
TMNS=TIM< I >/60. 

SN=SIZ(I)/100. 

SFT=SIZ(I)/(2. 54*12.) 

CALL  PAGER ( 1 ) 

URITE(LP»24)  TIM( I) . ThNS»SIZ( I ) .SM.SFT 

25  CONTINUE 
IFUSPT.NE.l)  GO  TO  92 
CALL  PAGER(l) 

WRITE(LP»26) 

92  CONTINUE 

IF (STM.EQ.O.O.OR.ISPT ,EQ.l)  GO  TO  99 
CALL  PAGER<2) 

WRITE(LP» 27)  STM 
GO  TO  99 

21  F0RMAT(/21X.27HP00L  SIZE  VS  TIME  -  MODEL  D//> 

22  FORMAT (  8X.4HTIME.8X. 4HTIME.8X.4HSIZE.8X.4HSIZE.8X.4HSIZE) 

23  FORMAT (  7X.6H<SECS) .6X»6H<MINS> .7X.5H(CMS).BX.3H(M).8X.4H(FT)//> 

24  FORMAT (  5X.G10.4.2X.G10.4>2X.G10.4.2XrG10.4>2X.G10.4.2X.G10.4) 

26  FORMAT(6X.41HNOTE  -  THE  POOL  IS  ASSUMED  TO  BE  CIRCULAR) 

27  FORMAT < /17X.34H***  NOTE  -  AT  APPROXIMATELY  TIME  *»G10.4.10H  SECS. 
l***/17X.45H**t  THE  POOL  IS  CONFINED  BY  CHANNEL  BANKS  ***) 

50  F0RMAT(29H  THE  SPILL  POOL  IS  CIRCULARO  ) 

60  FORMAT (46H  THE  SPILL  POOL  IS  CONFINED  BY  CHANNEL  BANKSO  ) 

81  FORMAT (  49H  IN  CASE  MODEL  G  FOLLOWS.  VAPOR  SOURCE  PARAMETERS/24H  A 
IRE  ESTIMATED  AS  BEING-) 

100  FORMAT ( /IX. 68HUARNING  -  THE  LIQUID  DENSITY  OF  THE  SPILLED  CHEMICAL 
*  IS  SO  CLOSE  TO/  1X.68HWATER  THAT  IT  MAY  OR  NOT  FLOAT.  FOR  MODEL 
*D.  IT  WILL  BE  ASSUMED  THAT/  1X.29HTHE  DENSITY  IS  0.99  GM/CN**3.//> 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

cc 

c 

c 

c 


200  FORMAT (/60H  DIH  SPILL  IS  SET  TO  MEAN  POOL  SIZE  IN  CASE  MODEL  5  FOL 
*LOWS.) 

99  CONTINUE 

CALL  TRACE< 1 «6, 0) 

END 

SUBROUTINE  COMPQ(TINF,TCRY,Q> 

THIS  SUBROUTINE  CALCULATES  THE  HEAT  FLUX  BETWEEN  HATER  AND  A 
LIQUID  UHOSE  BOILING  POINT  IS  LESS  THAN  AMBIENT.  THE  ESTIMATION 
IS  KNOWN  TO  BE  CORRECT  ONLY  FOR  LIQUEFIED  NATURAL  GAS.  THE 
FLUXES  FOR  OTHER  SUBSTANCES  ARE  COMPUTED  BY  ASSUMING  THAT  THEIR 
HEAT  TRANSFER  COEFFICIENTS  ARE  EQUAL  TO  THE  EXPERIMENTALLY 
DETERMINED  HEAT  FLUX  FOR  LNG  DIVIDED  BY 
TEMPERATURE  BETWEEN  LNG  AND  HATER  AT  20 


THE  DIFFERENCE  IN 
DEGREES  CENTIGRADE. 


**»  INPUTS 

TINF 
TCRY 


WATER  TEMPERATURE » DEGREES  C 
BOILING  TEMPERATURE  OF  LIQUID, DEGREES 


***  OUTPUTS 


0 


HEAT  FLUX,CAL/SEC-CM**2. 


Q=(2.5/181.)*ABS(TINF-TCRY> 

RETURN 
END 

SUBROUTINE  CRIT ( I , ITC , GAM, DEL , TOWC, KHIC, KC) 

C 

cmmmmmmmmmmtmmmmtmmmmmmmmm 

c 


THIS  SUBROUTINE  CALCULATES  THE  CRITICAL  TIME,  CRITICAL  VOLUME  AND 
THE  CRITICAL  SIZE  OF  SPREAD  FOR  SUBSTANCES  OF  THE  TYPE  ADDRESSED 
BY  MODEL  D.  CRITICALITY  IS  DEFINED  AS  THE  INSTANT  IN  TIME  AT 
WHICH  THE  GRAVITY  INERTIA  SPREAD  CHANGES  OVER  TO  THE  GRAVITY 
VISCOUS  REGIME.  FOR  MORE  DETAILS  SEE  THE  TECHNICAL  REPORT 
WHICH  DESCRIBES  THE  WORKINGS  OF  MODEL  D.  THE  NOMENCLATURE  USED 
IN  THIS  ROUTINE  FOR  THE  VARIOUS  QUANTITIES  IS  THE  SAME  AS  THAT 
USED  IN  THE  TECHNICAL  REPORT. 


C 
C 
C 
C 
C 
C 
C 
C 
C 

c 
c 

c*mm**m*m**mmmm**mmm*tmm*m*mm***m*m* 

c 

REAL  K,KC »KHI ,KHIC»KHIMX 
IF ( ITC-1 )  5,1,5 

C  **  TOU-5.  IS  ARBITRARILY  SET  TO  FIRST  FIND  OUT  THE  TIHE  FOR  COMPLE 

1  T0W=5 . 

CALL  GRSPD(I,TOW,DEL,KHI,K,ETA,TOWEN,KHIMX) 

DT0W=T0WEN/100 . 

TOW=TOWEN 

2  TOW=TQW-DT0W 

CALL  GRSPD( I ,TOW, DEL,KHI ,K,ETA,TOWEN,KHIMX) 

BLT=SQRT(TOW)/GAM 

E=ETA-BLT 

IF ( E >  3,4,4 

3  E1=E 

GO  TO  2 

4  rOWC=TOW+DTOW*E/(E+ABS(El ) ) 

CALL  GRSPD ( I , TOWC , DEL , KHIC , KC , ETA , TOWEN , KHIM/ ) 

5  RETURN 

SUBROUTINE  CRYSP< IDIM, IQ, Q, VI ,DENL,VISL,HLATL, TCRY, TINF, CHNLW, TIME 
1, ITC, TOWC, KC, KHIC, VOL, SIZE, SIZMX,TEVAP) 

C 

c 


Intsofns? 

TIME  FOR 


FOR  SPREAD  OF  A  CRYOGEN.  THIS  ROUTINE  GIVES  1 

WiE^L^SpS^I?S^IEfShPSlASA§FsS^Y8§l 


HE 


;rys 

iXT? 

THE 

ON  WATER.  THE  NOMENCLATURE  USED  FOR  THE  VARIOUS  PARAMETERS  IS  THE 


N 
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SAME  AS  THAT  USED  IN  THE  TECHNICAL  REPORT  WHICH  DESCRIBES  HOW 
MODEL  D  WAS  DEVELOPED. 

mmmmmiNPUT  parameters*************** 

IDIM  =A  FLAG  INDICATING  WHETHER  THE  POOL  SPREADS  RADIALLY 

OR  IS  CONFINED  BY  CHANNEL  BANKS.  1  MEANS  IT  IS  CONFINED 
BY  CHANNEL  BANKS.  2  MEANS  IT  SPREADS  RADIALLY. 

IQ  =FLAG  WHICH  SPECIFIES  WHETHER  THE  HEAT  TRANSFER  IS 

LIMITED  BY  ICE  FORMATION  UNDER  THE  SPREADING  LIQUID 
OR  WHETHER  IT  IS  CONSTANT.  1  IS  FOR  CONSTANT  HEAT. 

2  IS  FOR  ICE  FORMATION. 

Q  =VALUE  OF  THE  CONSTANT  HEAT  FLUX  IF  IQ=1 »CAL/CM**2-SEC 

VI  INITIAL  VOLUME  OF  SPILLED  LIQUID,  CM**3 

DENL  =DENSITY  OF  LIQUID.  G/CM**3 

VISL  =VISCOSITY  OF  SPILLED  LIQUID.  G/CM-SEC 

HLATL  =LATENT  HEAT  OF  EVAPORATION  OF  LIQUID.  CAL/G 
TCRY  TEMPERATURE  OF  SPILLED  LIQUID.  DEG  C 
TINF  TEMPERATURE  OF  WATER  FAR  FROM  SPILL  INTERFACE. DEG  C 
CHNLW  =WIDTH  OF  THE  CHANNEL  WHERE  SPILL  OCCURS.  CM 
(REQUIRED  ONLY  IF  SPILL  POOL  IS  CONFINED) 

TIME  TIME  AT  WHICH  OUTPUT  PARAMETERS  ARE  DESIRED.  SEC 
ITC  =A  FLAG  INDICATING  WHETHER  CERTAIN  CALCULATIONS 

ARE  DESIRED.  BY  SETTING  THIS  FLAG  TO  1  THE  FIRST 
TIME  THROUGH  THE  ROUTINE,  THESE  VALUES  ARE  COMPUTED.. 
THEREAFTER,  THE  FLAG  SHOUD  BE  SET  TO  SOME  OTHER 
VALUE  TO  PREVENT  THESE  CERTAIN  PARAMETERS  FROM  BEING 
RECALCULATED.  THIS  SAVES  CPU  TIME  IN  ITERATION 
FOR  PLOT  AND  TABLE  ARRAY  DEVELOPMENT. 


*«*************OUTPUT  PARAMETERS******************* 


TOWC  =  DIMENSIONLESS  TIME  AT  WHICH  THE  SPREAD  CHANGES 
REGIMES 

KC  =BIMENSIONLESS  VOLUME  AT  CRITICAL  TIME  TOWC 

KHIC  =BIMENSIONLESS  CRITICAL  SPREAD  EXTENT 
VOL  =VOLUME  OF  LIQUID  REMAINING  AT  SPECIFIED  TIME,  CM**3 

SIZE  =EXTENT  OF  SPREAD  AT  SPECIFIED  TIME,  CM 

(RADIUS  OR  LENGTH  OF  CHANNEL  COVERED  DEPENDING 
UPON  THE  VALUE  OF  IDIM  GIVEN  AS  INPUT) 

SIZMX  =MAX  POOL  SIZE  (RADIUS  OR  LENGTH  AS  ABOVE),  CM 

TEVAP  =TIME  FOR  ALL  LIQUID  TO  EVAPORATE,  SEC 


REAL  K,KC,KHI »KHIC,KHIM,KICE,L,KHIMX 
DATA  CPI » TF/0 .502 , 0 . 0/ 

DATA  GR jPI.KICE.VISW.HLATI, DENI, DENW/980  ,3.14159265,0.005,0.01, 
180. ,0.92,1.0/ 

G=GR*( 1 .-DENL/DENW) 

GAML=(VI*G/ (VISL/DENL)**2)**0 .25 
GAMW=(VI*G/(VISW/DENW)**2)**0.25 
L=VI**(l./3. ) 

IF ( IDIM-1 )  1,1,2 
L=SQRT(  0.5*  VI /CHNI.W) 

HFSEF=HLATI+(TINF-TF)+0.5*CPI*(TF-TCRY) 

ALFAP=5QRT ( (KICE*(TF-TCRY)*DENI*HFSEF)/( ( (HLATL*DENL)**2)*SQRT (VI* 
1G))) 

ALFA=2.*PI*ALFAP 
BETA=(PI/2 , )*ALFAP 
CHTM=SQRT (L/G ) 

DEL=Q/ ( HLATL* DENL* (L/CHTM ) ) 

****  SPREAD  CALCULATIONS  BEGIN  ***** 

TOW=TIME/CHTM 
GO  TO  (3, 14), IDIM 
GO  TO  (4, 11), IQ 

***  ONE  DIMENSION  SPREAD  WITH  CONSTANT  HEAT  FLUX  **** 

1  =  1 

IF(VISL-0.5*VISW)  8,5,5 
5  CALL  CRIT(I, ITC, GAMW, DEL, TOWC, KHIC, KC) 

T0WE=T0WC*(1.+1.375*KC/(T0WC*KHIC*DEL))*(8./11.) 
KHIM=KHIC*(TOWE/TOWC) **0.375 
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IF (TOW-TOWC)  6,6,7 

6  CALL  GRSPD(I,TOU,DEL,KHI ,K,ETA,TOWEN»KHIMX) 

GO  TO  1000 

7  KHI=KHIC*(T0W/T0WC>**0.375 
K=KC-(T0UC*KHIC*DEL/1.375)*((T0W/T0WC)**1. 375-1.) 

GO  TO  1000 

8  CALL  CRITd, ITC, GAML.DEL, TOWC, KHIC.KC) 
T0WE=T0UC*(l.+1.2*KC/(T0UC*KHIC*DEL))**<5./6.) 
KHIM=KHIC*(TOWE/TOUC>**0.2 

IF (TOW-TOWC)  9,9,10 

9  CALL  GRSPD ( I .TOW.DEL ,KHI »K»ETA,TOWEN,KHIMX) 

GO  TO  1000 

10  KHI=KHIC*(T0W/T0WC)**0.2 
K=KC-(T0UC*KH1C*DEL/1.2)*((T0W/T0WC)**1.2-1.) 

GO  TO  1000 

C  ***  ICE  FORMATION  ****  ONE  DIMENSIONAL  SPREAD  **** 

11  1=2 

CALL  CRITd , ITC »GAHL» BETA » TOWC,KHIC»KC ) 
T0WE=T0WC*(1.+0.7*KC/(BETA*KHIC*SQRT (TOWC )))**( 10. /7.) 


KHIM=KHIC*(T0WE/T0WC)**0.2 
IF (TOW-TOWC)  12 » 12 » 13 

CALL  GRSPDd ,TOW,BET A, KHI.K, ETA, TOWEN,KHIMX) 

GO  TO  1000 

KHI=KHIC*(TOW/TOWC)**0.2 

K=KC-(10.*BETA/7.)*KHIC*SGRT(T0WC)*< (T0U/T0WC)**0 .7-1 . ) 
GO  TO  1000 


C  ******  RADIAL  SPREAD  ********  CONSTANT  HEAT  FLUX  ****** 

14  GO  TO  < 15 » 22) » IQ 

15  1=3 

IF ( VISL-VISW*0.5)  19,16,16 

16  CALL  CRITd, ITC, GAMW.DEL.TOWC, KHIC, KC) 

TOWE=TOWC*( 1 .+1 .5*KC/(PI*T0WC*DEL*KHIC**2 )  )*<(2./3. ) 

KHIM=KHIC* ( TOWE/TOWC ) **0 . 25 

IF (TOU-TOWC)  17,17.18 

17  CALL  GRSPDd ,TOW,DEL»KHI»K»ETA,TOWEN»KHIMX) 

GO  TO  1000 

18  KHI=KHIC*(T0W/T0WC)**0.25 
K=KC-((DEL*PI/1.5)*TOWC*KHIC**2)*((TOW/TOWC)**1.5-1.) 

GO  TO  1000 

19  CALL  CRITd » ITC, GAML » DEL, TOWC, KHIC, KC )  ^  „ 

TOWE=TQUC* ( 1 . +1 . 25*KC/ ( PI*T0WC*DEL*KHIC**2 ) )**0 . 8 
KHIM=KHIC* (TOWE/TOWC) **0.125 

IF ( TOU-TOWC)  20,20,21 

20  CALL  GRSPDd, TOW, DEL, KHI.K, ETA, TOWEN.KHIMX) 

GO  TO  1000 

21  KHI=KHIC*(TOW/TOWC> **0.125 

K=KC-(DEL*PI/1 .25)*T0WC*KHIC**2*( (T0W/T0WC)**1 .25-1 , ) 

GO  TO  1000 

22  1=4 

CALL  CRITd, ITC, GAML, ALFA, TOWC, KHIC, KC) 

TOWE=TOWC*< 1 . +0 . 75*KC/(PI*ALFA*KHIC**2*SQRT(T0WC>  > )**(4,/3. ) 
KHIM=KHIC*(TOWE/TOWC) **0.125 
IF (TOW-TOWC)  23,23,24 

23  CALL  GRSPDd, TOW, ALFA, KHI.K. ETA, TOWEN.KHIMX) 

GO  TO  1000 

24  KHI=KHIC*(TOW/TOWC)**0. 125 
K=KC-(4.*PI*ALFA*T0WC*KHIC**2/3. )*( (TOW/TOWC) **0.75-1 . > 

C  ******  CONVERSION  TO  DIMENSIONAL  UNITS  ****** 

1000  VOL=K*VI 

SIZE=FLOAT (3-IDIM)*L*KHI 

SIZMX=FL0AT(3-IDIM)*L*KHIM 

TEVAP=TOWE*CHTM 

ITC=0 

RETURN 

END 

SUBROUTINE  DSPRD(DENL,DIA,HGT,FLOW,Q,HTVAP,TIME,SIZE,TMAX,SIZMX) 

C 

C *********************************************************************** 

C 

C  THIS  SUBROUTINE  CALCULATES  THE  POOL  SIZE  VERSUS  TIME  FOR  A 
C  CONTINUOUS  DISCHARGE  OF  A  LIGHTER-THAN-WATER  INSOLUBLE  LIQUID 
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WITH  BOILING  POINT  LESS  THAN  AHBIENT.  IT  WORKS  ONLY  FOR  RADIAL 
SPREADING. 


#**  INPUTS  *** 

DENL  DENSITY  OF  DISCHARGED  LIQUID  6M/CMM3 

DIA  DIAMETER  OF  HOLE  CM 

HGT  HEIGHT  OF  HOLE  ABOVE  WATER  CM 

FLOW  MASS  RATE  OF  FLOW  OF  DISCHARGED  SUBSTANCE  GM/SEC 

Q  HEAT  FLUX  BETWEEN  WATER  AND  CHEMICAL  POOL  CAL/SEC-CM**2 

HTVAP  HEAT  OF  VAPORIZATION  OF  DISCHARGED  LIQUID  CAL/GM 

TIME  ELAPSED  TIME  AFTER  SPILL  STARTS  AT  WHICH 

POOL  SIZE  IS  DESIRED  SECS 

***  OUTPUTS  *t* 

SIZE  RADIUS  OF  POOL  AT  SPECIFIED  TIME  CM 

TMAX  TIME  AT  WHICH  POOL  REACHES  MAXIMUM  RADIUS  SECS 

SIZMX  MAXIMUM  RADIUS  POOL  WILL  ATTAIN  CM 

REAL  KrKHIMX 
PI=3. 141592654 
G=980. 

BENW=1 .0 

CALCULATING  THE  JET  ENTRY  PARAMETERS.  HYDRAULIC  PUMP  RADIUS 
AND  THE  RADIAL  OUTFLOW  VELOCITY. 

FLW=FLOW/DENL 
GRAV=G* ( 1 , -DENL/DENW ) 

10  RN=DlA/2. 

VEL=FLU/<<F'I/4.)*DIA*DIA> 

FDJET=VEL*VEL/(GRAV*(DIA/2.)) 

U=SQRTUVEL**2.)  +  (2.*G*HGT)) 

A“DIA#SGRT<VEL/U)/2. 

HB-A/2 * 

FB=2.*U*U/(GRAV*A) 

FA=8.*FB/<  <SQRT( (8, *FB)  +1.1-1, )**3.1 
HA=HB*(FB/FA)**<l./3.) 

UA=U#HB/HA 

CALCULATING  THE  RADIAL  SPREAD  PARAMETERS. 

TCH=A/UA 
TAU=TIME/TCH 
F=UAtUA/(HA*GRAV> 

El=0.41 
E0=0.48 

CRYOGENIC  SPREADING  ANALYSIS 
CALCULATION  OF  PARAMETERS 

YDOT=G/(HTVAP*DENL) 

GAMMA=A*YD0T/<2.*UA*HA) 

TCH=A/UA 

K=El*F/<l.-2.*El)*t2 
C-SQRT (2./(l .-2,*E1) ) 

EPSILN=K*GAMMA*C*C 

MAXIMUM  SPREAD  CALCULATION 

KHIMX=SQRT(1. /GAMMA) 

T0WBMX=1 .6/EPS ILN 

TMAX»K*TCH*TOWBMX 

SIZMX=A*KHIMX 

IFCTIME.LT. TMAX )  GO  TO  40 

S{ZE*SIZMX 

RETURN 

40  TOWBAR=TIHE/(K*TCH) 

ET0W8=EPSILN*T0W*AR 


V 


SIGMA=TOWBAR*((1./6.)*ETOWB*ETOWB-0.5*ETOWB+1.) 

PSI=C*SQRT(SIGMA*K> 

SIZE=(1.+PSI)*A 

RETURN 

END 

SUBROUTINE  GRSPD( I » TOW.DEL ,KHI » K.ETA.TQWEN.KHIMX) 

c  *********************************************************************** 

C  THIS  SUBROUTINE  RETURNS  DIMENSIONLESS  VALUES  FOR  THE  EXTENT  OF 

C  VOLUMEN  OF  LOQUID  REMAINING 

C  VOLUME  OF  LIQUID.TIME  FOR  COMLETE  EVAPORATION  ETC.,  FOR  THE  SPR 

C  CRYOGENIC  LIQUID  ON  WATER. 

C 

C********»******INPUT  PARAMETERS****************** 

C  ***  I  =  A  FLAG  WHICH  INDICATES  WHAT  KIND  OF  SPREAD  THE  LIQUID  IS 

C  GOING  (I  =1  FOR  ONE  DIMENSIONAL  SPREAD  WITH  CONSTANT  HEA 

C  2  FOR  ONE-DIM  SPREAD  UITH  ICE  FORMATION.  3  FOR  RADIAL  SP 

C  WITH  CONSTANT  HEAT  FLUX.  AND  4  FOR  RADIAL  SPREAD  WITH  IC 

C  TION.) 

C  ***  TOW  =  DIMENSIONALESS  TIME  AT  WHICH  THE  VARIOUS  QUANTITIES  ARE 

C  ***  DEL  =  A  QUANTITY  THAT  IS  RELATED  TO  THE  HEAT  FLUX 

C 

CX****t*********OUTPUT  PARAMETERS****************** 

C  ***  KHI  =  DIMENSIONLESS  EXTENT  OF  SPREAD 

C  ***  K  =  DIMENSIONLESS  VOLUME  OF  THE  LIQUID 

C  ***  ETA  =  DIMENSIONLESS  THICKNESS  OF  THE  LIQUID  FILM  DURING  SPREAD 

C  ***  TOWEN=  DIMENSIONLESS  TIME  FOR  COMOLETE  EVAPORATION  IF  THE  SPREA 
C  CONTINUES  IN  THE  GRAVITY  INERTIA  REGIME  ONLY. 

C  ***  KHIMX=  MAXIMUM  EXTENT  OF  SPREAD (DIMENSIONLESS)  IF  THE  SPREAD  CO 

C  IN  THE  GRAVITY-INERTIA  REGIME  ONLY. 

C 

C,  *********************************************************************** 


REAL  K.KHI.KH1MX 

PI=3. 14159265 

GO  TO  (10,20,30.40).! 

It*  ONE  DIMENSIONAL  SPREAO  WITH  CONSTANT  HEAT  FLUX  **t 
KHI=1.39*T0W**(2./3. )+Q.O?66*DEL*TOW**(7./3. ) 
K=1.-0.834*TOU**(5./3.)*DEL-0.029*<TOW**(10./3.))*DEL**2 
ETA=K/KHI 

KHIMX=1 .5874/ ( DEL** « 4 ) 

TQWEN= 1.0891 /(DEL **.6) 

RETURN 

***  ONE  DIMENSIONAL  SPREAD  WITH  ICE  FORMATION  *** 

KHI=1 ,39*T0W**(2./3. ) 

K=l.-1.19*DEL*T0W**(7./6. ) 

ETA=K/KHI 

T0WEN=0 . 859/( DEL** ( 6 . /7 . ) ) 

KHIMX=1.39*(T0WEN**(2./3. )) 

RETURN 

***  RADIAL  SPREAD  WITH  CONSTANT  HEAT  TRANSFER  RATE  *** 
KHI=SQRT (l,3*TOW+0.442*DEL*TOW**3) 

K=1 ,-2,04*DEL*T0W**2-0,347*(DEL**2)*(T0W**4) 
ETA=K/(PI*KHI**2) 

TQWEN=0.6743/SQRT (DEL) 

KHIMX=1.0059/(DEL**0.25) 

RETURN 

***  RADIAL  SPREAD  WITH  ICE  FORMATION  *** 

KHI=SQRT ( 1 , 415*DEL*T0U**2 . 5+1 . 3*T0W ) 

K=1,-0.867*DEL*T0W**1.5-0.4716*(DEL**2)*(T0W**3) 

ETA=K/(PI*KHI**2) 

T0WEN=0.864/(DEL**(2«/3. ) ) 

KHIMX=1 ,451/(DEL**(1 ./3. ) ) 

RETURN 

END 

0VERLAY(7,0> 

PROGRAM  0V7 

0V7  EXECUTES  THE  FOLLOWING  GROUP  OF  RATE  MODELS  - 


RATE  MODEL  = 


INDEX  = 
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COMMON  VARIABLES  USED  -  MODNO 


SUBROUTINES  REQUIRED 


MODF * MODM . MODO  *  MODY . MODZ  *  MODI 1 * MODRR 1 
MODSSf TRACE 


AUTHOR  -  R.G.  POTTSt  ARTHUR  D.  LITTLE*  INC.* 

35/309A  ACORN  PARK* 
CAMBRIDGE*  MASS.*  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  8  JANUARY  1976 


C0MM0N/0VCNT /MODNO *  OVLST  <  29 >  * SGLST ( 29  ) 
INTEGER  OVLST* SGLST 


-—PRINT  OVERLAY  EXECUTION  TRACE  MESSAGE*  THEN  BRANCH  ON  MODEL 
INDEX  NUMBER 
CALL  TRACE(0*7»0) 


- SELECT  MODEL  F 

IF(M0DN0.NE.6)  GO  TO  10 
CALL  MODF 
GO  TO  100 


- SELECT  MODEL  M 

10  IFCM0DN0.NE.13)  GO  TO  20 
CALL  MODM 
GO  TO  100 


. SELECT  MODEL  0 

20  IF ( MODNO. NE. 15)  GO  TO  30 
CALL  MODO 
GO  TO  100 


- SELECT  MODEL  Y 

30  IF(M0DN0<NE.25)  GO  TO  40 
CALL  MODY 
GO  TO  100 


. SELECT  MODEL  Z 

40  IF(M0DN0,NE.26)  GO  TO  50 
CALL  MODZ 
GO  TO  100 


. SELECT  MODEL  II 

50  IF(M0DN0.NE.27>  GO  TO  60 
CALL  MODI  I 
GO  TO  100 


. SELECT  MODEL  RR 

60  IF<M0DN0,NE.28>  GO  TO  70 
CALL  MODRR 
GO  TO  100 


. SELECT  MODEL  SS 

70  1F1M0DN0.NE.29)  GO  TO  100 
CALL  MODSS 


- . PRINT  OVERLAY  EXECUTION  TRACE  MESSAGE.  THEN  RETURN  TO  MAIN 

HACS  CONTROL 
100  CALL  TRACE  < 1 » 7 * 0 ) 

END 

SUBROUTINE  MODF 
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CALL  PAGER  C  2 ) 

WRITE ( &» 100) 

RETURN 

100  F0RMAT(57H  MODEL  F  HAS  BEEN  FUNCTIONALLY  INCORPORATED  INTO  MODEL  D 

1./) 

END 

SUBROUTINE  MODII 

CALL  PAGER(2> 

WRITE ( 6 » 100 ) 

RETURN 

100  FORMAT (45H  MODEL  FOR  INSOLUBLE  SOLIDS  IS  NOT  AVAILABLE./) 

END 

SUBROUTINE  MODM 
DATA  M0D/4H  M  / 
l  CONTINUE 
LP=6 
IR=0 
IS=6 

CALL  BEGPR(MOD) 

CALL  IRCL(2084>IFLAGi ISfIR) 

CALL  EPRNTIMODi IS> IR> IL) 

IF(IL.EQ.l)  GO  TO  99 
IF (IL.EQ.2)  GO  TO  1 
CALL  OUTPR(MOD) 

CALL  PAGERU) 

MRITE(LPrlOO) 

CALL  ISV<2061i0»2> 

IF ( IFLAG.EQ. 1 )  GO  TO  20 
CALL  PAGER<4) 

WRITE(LP»200) 

20  CALL  ENDPR(MOD) 

99  RETURN 

JO  F0RMAT(66H  MODEL  FOR  EVAPORATION  RATE  OF  SOLUBLE  LIQUIDS  WHOSE  BOI 
ILING  P0INT/39H  IS  LESS  THAN  AMBIENT  IS  NOT  AVAILABLE. /51H  IN  ORDER 
2  TO  ASSESS  THE  VAPOR  HAZARD  UE  ASSUME  THAT/40H  ALL  THE  GAS  IS  EVOL 
3VED  INSTANTANEOUSLY./) 

200  FORMAT (/56H  MODEL  K  HAS  ALREADY  ESTIMATED  THE  AMOUNT  OF  VAPOR  UHIC 
1H/42H  EVOLVES.  THIS  AMOUNT  IS  USED  IN  MODEL  N./) 

END 

SUBROUTINE  MODO 
CALL  PAGER<7> 

WRITER. 100) 

RETURN 

100  FQRMAT<58H  MODEL  FOR  HEAT  RELEASE  FROM  LIQUIDS  THAT  REACT  WITH  WAT 
1ER/1BH  IS  NOT  AVAILABLE. /55H  CONSULT  MANUAL  2  TO  DETERMINE  THE  PRO 
2DUCTS  OF  REACTI0N/27H  OF  THE  CHEMICAL  AND  WATER. /62H  HAZARDS  MAY  B 
3E  ESTIMATED  SEPARATELY  IF  THE  PRODUCTS  HAVE  BEEN/33H  INCLUDED  ON  T 
4HE  PROPERTIES  FILE./) 

END 

SUBROUTINE  MODRR 

CALL  PAGER<2) 

WRITE (6> 100) 

RETURN 

100  FORMAT (44H  MODEL  FOR  REACTIVE  SOLIDS  IS  NOT  AVAILABLE./) 

END 

SUBROUTINE  MODSS 

CALL  PAGERI2) 

WRITE  <6*100) 

RETURN 

100  FORMAT (45H  MODEL  FOR  INSOLUBLE  SOLIDS  IS  NOT  AVAILABLE./) 

END 

SUBROUTINE  MODY 

CALL  PAGER12) 

WRITE(6f 100) 

RETURN 

100  F0RMAT124H  MODEL  Y  DOES  NOT  EXIST./) 

END 

SUBROUTINE  MODZ 
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c 

CALL  PAGER<2> 

URITEUtlOO) 

RETURN 

100  FORMAT (53H  MODEL  FOR  SELF  REACTING  SUBSTANCES  IS  NOT  AVAILABLE./) 
END 

OVERLAY(IO.O) 

PROGRAM  0V8 

PROGRAM  0V8  EXECUTES  THE  FOLLOWING  GROUP  OF  RATE  MODELS  - 

RATE  MODEL  =  INDEX  = 

I  9 

K  11 

P  16 

R  18 

T  20 

V  22 

X  24 

COMMON  VARIABLES  USED  -  MODNO 

SUBROUTINES  REQUIRED  -  MODK.MQDP.MODR.MODT »MODV. TRACE  . 

AUTHOR  -  R.G.  POTTS.  ARTHUR  D.  LITTLE.  INC.. 

35/309A  ACORN  PARK. 

CAMBRIDGE.  MASS..  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  8  JANUARY  1976 

COMMON/OVER/NOV. SEG 
COMMON/OVCNT/NODNO»OVLST<29)»SGLST<29> 

INTEGER  OVLST.SGLST 

. PRINT  OVERLAY  EXECUTION  TRACE  MESSAGE.  THEN  BRANCH  ON  MODEL 

INDEX  NUMBER 
CALL  TRACE(0.8.0) 

C 

C - SELECT  MODEL  I 

IFIM0DN0.NE.9)  GO  TO  10 
SEG=1 

CALL  SEGLOD(l) 

GO  TO  100 
C 

C - SELECT  MODEL  K 

10  IF(MODNO.NE.ll)  GO  TO  20 
SEG=2 

CALL  SEGL0D(2) 

GO  TO  100 
C 

C - SELECT  MODEL  P 

20  IF (MODNO. NE .16)  GO  TO  30 
SEG=2 

CALL  SEGL0D(2) 

GO  TO  100 
C 

C - SELECT  MODEL  R 

30  IF(M0DN0.NE,18)  GO  TO  40 
SEG=3 

CALL  SEGL0D<3> 

GO  TO  100 
C 

C . SELECT  MODEL  T 

40  IF(M0DN0.NE.20)  GO  TO  50 
SEG=4 

CALL  SEGL0D(4) 

GO  TO  100 
C 

C - SELECT  MODEL  V 

50  IF(M0DN0.NE.22)  GO  TO  60 
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SEG=5 

CALL  SEGL0D<5) 

GO  TO  100 

c 

C . SELECT  MODEL  X 

60  IF<M0DN0.NE.24>  GO  TO  100 
SEG=6 

CALL  SEGL0D(6) 


. PRINT  OVERLAY  EXECUTION  TRACE  MESSAGE*  THEN  RETURN  TO  MAIN 

HACS  CONTROL 
100  CALL  TRACEU*B*0> 


SUBROUTINE  CDIFU( AM. DENL . THAT » TCRIT . TB0IL. DIFC0) 

THIS  SUBROUTINE  ESTIMATES  THE  DIFFUSION  COEFFICIENT  FOR  A  LIQUID 
CHEMICAL  IN  WATER 


***  INPUTS  *** 

AM  MOLECULAR  WEIGHT  OF  CHEMICAL 
DENL  DENSITY  OF  CHEMICAL  AT  ITS  BOILING  POINT 
TWAT  TEMPERATURE  OF  WATER 
TCRIT  CRITICAL  TEMPERATURE  OF  CHEMICAL 
TBOIL  BOILING  TEMPERATURE  OF  CHEMICAL 

***  OUTPUTS  *** 


DIFCO 


DIFFUSION  COEFFICIENT  OF  CHEMICAL  IN  WATER 


GM/MOLE 
GM/CM3 
DEG.  C 
DEG.  C 
DEG.  C 


CM2/SEC 


TR=(TWAT+273.2)/(TCRIT+273.2) 

TBR=(TB0IL+273.2)/(TCRIT+273.2) 

MOLAL  VOLUME  (VB)  CALCULATION  IS  MATHIAS  METHOD  FOUND  ON  PG  106 
OF  2ND  ED.  OF  REID  AND  SHERWOOD.  THE  PROPS  OF  GASES  AND  LIQUIDS 

VB=(AM/DENL)*<  <2.-TR)/(2.-TBR> ) 

VISCOSITY  OF  WATER  EQUATION  IS  FROM  PAGE  374  OF  THE  THIRD  EDITION 
OF  PERRY'S  CHEMICAL  ENGINEERING  HANDBOOK 

VISW=(2.1482*< (TWAT-8.435)+SQRT(8078.4+((TWAT-8.435)**2.))))-120. 
VISW=100./VISW 

DIFFUSION  COEFFICIENT  EQUATION  IS  WILKE  AND  CHANG  METHOD  FOUND 
IN  REID  AND  SHERWOOD  ON  PG  549. 

IHFCO=5.06E-07*<TWAT+273,2)/(<VISWm,l)*(VB**0.6)> 

RETURN 

END 

SUBROUTINE  C0MPD( AM. TA.DENLB. DIFCO) 

THIS  SUBROUTINE  CALCULATES  THE  DIFFUSION  COEFFICIENT  OF  A  VAPOR  IN 
AND  SHOULD  BE  THE  DEFAULT  VALUE  IF  THE  DATA  IS  NOT  PRESENT  IN  THE 
MANUAL  2  DATA  FILE. 

MtlNPUTS 

AM  THE  MOLECULAR  WEIGHT  OF  THE  CHEMICAL 
TA  AMBIENT  TEMPERATURE. DEGREES  C 

DENLB  THE  DENSITY  OF  THE  LIQUID  AT  ITS  BOILING  POINT. GN/CMM3. 
•MOUTPUTS 

DIFCO  THE  DIFFUSION  COEFFICIENT. CM**2. /SEC 

VB=29. 9*4.33333 

WM0*29.0 

VA»AM/DENLB 
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T=<TA+273.2>**1.5 

S1  =  ((1./WM0)U1./AM>)**.5Q 

52=<<VA**,33333)+VB>**2. 

DIFC0=.0043*<T/S2)*S1 

RETURN 

END 

SUBROUTINE  CRITD< AVPiBVP »C VP » TEMP » DEPTH) 

*t*************m******t***t*****ttm********************tM**t**** 

THIS  SUBROUTINE  CALCULATES  THE  DEPTH  IN  WATER  AT  WHICH  A  LIQUID 
WITH  A  BOILING  POINT  LESS-THAN-AMBIENT  TEMPERATURE  WILL  NOT  BOIL 
BECAUSE  OF  THE  HYDROSTATIC  PRESSURE  ACTING  UPON  IT.  IT  IS 
PRIMARILY  USEFUL  FOR  HEAVIER-THAN-WATER  CHEMICALS  SINCE  LIGHTER 
SUBSTANCES  WILL  RISE  UNTIL  THEY  REACH  A  DEPTH  AT  WHICH  THEY  CAN 
BOIL. 


***  INPUTS  *** 


COEFFICIENT  OF  VAPOR  PRESSURE  EQUATION  WHICH 
GIVES  ANSWER  IN  MM  HG. 


TEMPERATURE  OF  CHEMICAL 


DEG.  C 


***  OUTPUTS  *** 


DEPTH 


DEPTH  AT  WHICH  CHEMICAL  WILL  NOT  BOIL 


c  ******************************************************************** 

GRAV=980,7 
DENL=1 .0 

VAP=1333.224*10.**<AVP-(BVP/(TEMP+CVP>>) 

PATM=760. *1333. 224 
IF ( VAF'.LE.PATM)  DEPTHS. 0 
IF< VAP .LE .PATH )  GO  TO  99 
DEPTH=(VAP-PATH) /(DENL*GRAV) 

99  RETURN 
END 

SUBROUTINE  DISF<W,D»IFLAG,T»UF,UT,XN,TP,E»EX,EY,EZ> 

C  ********************************************************************** 
C  ****  THIS  SUBROUTINE  IS  CALLED  BY  THE  DILUN  SUBROUTINE  .  DISPERSION 
C  AND  TURBULENT  DIFFUSION  COEFFICIENTS  ARE  RETURNED  BY  THIS  SUBROU 

C 

PI=3. 14159265 
B=W/2. 

IF ( IFLAG.EQ. 1 )  GO  TO  60 
RH=W*D/(2.*D+W) 

GO  TO  (60»70»80)*IFLAG 
60  E=0. 

RETURN 

C  ***  SPILL  INTO  A  NON  TIDAL  RIVER 

70  USTAR=6.7305*XN*UF/RH**( 1 ,/6. ) 

EZ=0.067*USTAR*RH 

EX=0.1*EZ 

IF(W/D-100.)  72 » 7 1 » 7 1 

71  EY=0.1*EZ 

E -136«09*XN*UF*RH**<5. /6. ) 

GO  TO  75 

72  EY=0.23*USTAR*RH 
E=225.*USTAR*RH 

75  RETURN 

C  ***  TIDAL  RIVER  ****** 

80  USTAR=6.7305*XN*(2.*UT/PI)/RH**(l./6.) 

C  ***  USTAR  IS  BASED  ON  THE  MEAN  OSCILLATING  FLOW  VELOCITY.  *** 

EZ*0. 067*USTAR*RH 

EX=0.1*EZ 

EY*0»1*EZ 

IF (W/D-100. )  81f 82rB2 

81  EYe0.23*USTAR*RH 

C  **  TRANSVERSE  AND  VERTICAL  DISPERSION  COEFFICIENTS 

82  EV*6.*D*USTAR 
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ET=0 . 01 1 10 . 025tEVt  <  UTtTP/B ) tt2 
TPV=TP/(Dtt2/EZ) 

TPT=JP/(Btt2/EY) 

IFCTPV-1 . >  83*83*84 
60  TO  85 

IF (ET/EV-1 . )  85*85*86 
E=EV 

GO  TO  87 
EsET 
RETURN 
END 

FUNCTION  ERF (X) 

DIMENSION  A(5> 

DATA  P/0.3275911/* 

1  A(l)/0. 254829592/ *A(2)/-0.284496736/*A(3)/l .421413741/* 

2  A(4>/-1. 453152027/* A(5)/l. 061405429/ 


ERF  COMPUTES  THE  ERROR  FUNCTION  OF  X  BY  SERIES  EXPANSION  WITH  AN 
ERROR  LESS  THAN  OR  EQUAL  TO  1.5110-7. 

REFERENCE..  C.  HASTINGS  JR. 

APPROXIMATIONS  FOR  DIGITAL  COMPUTERS 
PRINCETON  UNIVERSITY  PRESS 
PRINCETON  N.J.  1955 

. CODE  REVISIONS* INSERTED* 3  N0V* 1978  BY  r!g!  POTTS . 

INCLUDES  LIMIT  TEST  FOR  ASYMPTOTIC  VALUE 
ONE=l .0 

IF(X.LT.O.O)  0NE=-0NE 
T=0NE/(0NE+PtX) 

EX=EXP(-XtX) 

ERF=l,0-(T*(A(l)+Tt(A(2)+Tt(A(3)+Tt(A(4)+TtA(5)>)>)tEX) 

IF( ABS( 1 .O-ERF) .LT. 1 .5E-7)  ERF=1.0 

ERF=ONEtERF 

RETURN 

END 

SUBROUTINE  HMTC ( DIFCO. XMOL  * VOLI * HMP ) 

ANU=0. 15 
AL=V0LItt0.3333 
CUT=5.tl0.tt5 
TEMP=  293. 

RVAP=82 ,057/XMOL 
SCHM=ANU/DIFCO 
VELOC*  450. 

REYN=(VELOCtAL)/ANU 
IF(REYN-CUT)  1*1*2 

1  HBAR= ( 1 . 3284 ( REYNtt . 5 ) tDIFCOt ( SCHHtt . 3333 ) > /AL 
GO  TO  3 

2  HBAR= ( . 037tDIFC0t ( SCHMtt . 3333 ) t (REYNttO . 8 ) ) /AL 

3  HMP=HBAR/(RVAPtTEMP ) 

RETURN 

END 

SUBROUTINE  RLJSP U DIM t VOL » DENLfVISL * SURT *TIME* CHNLW . SIZE ) 

THIS  SUBROUTINE  CALCULATES  THE  SPREAD  OF  LIQUIDS  ON  WATER 


ttt  INPUTS 

IDIM 

VOL 

DENL 

VISL 

SURT 

TIME 

CHNLW 

ttt  OUTPUTS 


DIMENSION  OF  SPILL  (1  IF  ONE  DIMENSIONAL*  2  IF  RADIAL) 


QUANTITY  OF  SPILL 

DENSITY  OF  LIQUID 

VISCOSITY  OF  LIQUID 

SURFACE  TENSION  WITH  SEA  WATER 

Channel  WIDTH  (REQUIRED  FOR  IDIN=1  ONLY) 


CMtt3 

GM/CMtt3 

GM/CM-SEC 

DYNES/CM 

SEC 

CM 


SIZE  OF  SPILL  AFTER  TIME  HAS  ELAPSED  (RADIUS  OR  LENGTH) -CM 
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C. 


DATA  GR*DENU* VISU/980 . *  1 • * .01/ 

C..... CALCULATE  NON-DIMENSIONAL  PARAMETERS 
GO  TO  (5» 10) « I DIM 
5  AL=SQRT ( .5IV0L/CHNLW) 

DO  TO  15 
AL=VQL*t.  333333 
G=GRf ABS<  DENL-DENW)/DENU 
T=TIME/SQRT(AL/G) 

IF(VISU*.2  -  VISL)  25*25*85 

.START  CALCULATIONS  FOR  THE  CASE  UHEN  THE  LIQUID  VISOSITY  IS 

C . GREATER  THAN  THE  VISCOSITY  OF  WATER 

25  A=<AL**3*G)t*.25/SQRT<VISU/DENU) 

B=SURT/(VISW*SQRT<AL*G)> 

GO  TO  (35*60) fIDIM 

C . FOR  THE  ONE  DIMENSIONAL  CASE 

35  IF<T-A**<6./7.))40>40*45 

40  S=1.39#T**, 666666 

GO  TO  140 

45  IF(T-(.972*At*.75/SQRT(B))«*2. 66666) 50*50 *55 

50  S=1.39*A**.25*T**.375 

GO  TO  140 

55  S=1.43*SQRT(B/A)*T**.75 

GO  TO  140 

C . FOR  RADIAL  SPREADING 

60  IF(T-< .B6*A**.166666)**4)65>65i70 

65  S=1.14*SQRT(T) 

GO  TO  140 

IF<T-(,61*A**.666666)**2/B)75*75.B0 
S=.98<A*t.  166666IT0.25 
GO  TO  140 

S=1.6*SQRT(B/A)*T**.75 
GO  TO  140 

C . START  CALCULATIONS  FOR  THE  CASE  UHEN  THE  LIQUID  VISCOSITY  IS  LESS 

C . THAN  THE  VISCOSITY  OF  WATER 

85  A= ( AL**3*G ) ** . 25/SQRT ( VISL /DENL ) 

B=SURT/(VISL*SQRT(AL*G)> 

GO  TO  (90*115) flDIH 

C . FOR  THE  ONE  DIMENSIONAL  CASE 

90  IF <T-(. B1*A*». 4 )**< 15. /7.) >40*40*100 

100  IF(T-( . 90<At*.4/B*< , 333333) t<7.5) 105* 105* 110 
S=1.13*A**.4*T**.2 
GO  TO  140 

3=1. 26*(B*T)**. 333333 
GO  TO  140 

C . FOR  RADIAL  SPREADING 

115  IF(T-< .685*A**.25)**2. 66666)65*65*125 
IF(T-<  ,735*( A/B)K*. 25) **8)130* 130 *135 
S=.78*A«.25*T**.125 
GO  TO  140 

S=1.062*(B*T)**.25 

C . CALCULATE  SIZE  AND  RETURN 

140  SIZE=S*ALtFL0AT(3-IDIM) 

RETURN 

END 

SUBROUTINE  SOLUB(TEMP*CSAT*IS*IR) 

mmmmmmmtmmmt  mummmmmmtmmmm 


70 

75 

80 


105 

110 


125 

130 

13' 


THIS  SUBROUTINE  INTERROGATES  THE  STATE  FILE  TO  DETERMINE  THE 
AVAILABILITY  OF  CHEMICAL  SOLUBILITY  DATA.  IF  THE  COEFFICIENTS 
FOR  THE  SOLUBILITY  AS  A  FUNCTION  OF  TEMPERATURE  EQUATION  ARE 
PRESENT*  IT  UTILIZES  THEM  TO  CALCULATE  THE  SOLUBILITY  AT  THE 
SPECIFIED  TEMPERATURE.  IF  THEY  ARE  NOT  PRESENT*  IT  RETURNS  THE 
SOLUBILITY  AT  A  FIXED  TEMPERATURE  WHICH  MIGHT  ALTERNATIVELY  BE 
STORED  IN  THE  DATA  BASE. 


m  INPUTS  m 

TEMP  TEMPERATURE  AT  WHICH  SOLUBILITY  DESIRED 


DEG  C 


m  OUTPUTS  *** 


CSAT 


SOLUBILITY  OF  CHEMICAL 


GM  SOLUTE/  100  GMS  SOLVENT 
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IR  CODE  FOR  CONFIRMING  VALIDITY  OF  DATA  RECALLED  FROM 
SUBROUTINE  FRCL 

IS  SOURCE  CODE  OF  OUTPUT  OF  FRCL 

IND=0 
ISAVS=IS 
ISAVR=IR 
I S 1 =S 
IER1=0 

CALL  FRCL ( 1028 » SOLI f ISl flERl) 

IF(IERl.EQ.l)  IR=1 
IF < IS1 .LT* IS)  IS=IS1 
IS2=8 
IER2=0 

CALL  FRCL(102?.S0L2»IS2»IER2) 

IF (IER2.EQ. 1 )  IR=1 
IF ( IS2 ♦ LT *  IS )  IS=IS2 

IF < ISl '.  GT !  1  *AND*IS2^GT .  1 )  CSAT=S0L1+(S0L2»(TEMP+273.16) ) 
IF(ISl.GT.l.AND.IS2.GT.l)  RETURN 
CALL  PAGER (4) 

URITE(6»10) 

IF(IERl.EQ.1.0R.IER2.EQ.l)  IND=1 

IFdND.EQ.l.AND . ISAVR .EQ . 0)  IR  =  0 

IF ( ISl .LT. ISAVS .OR •  IS2  .LT. ISAVS)  IS=ISAVS 

IS3=8 

IER=0 

CALL  FRCL d 026  *CSAT i IS3i IER3 ) 

IF (IER3.EQ.1)  I R= 1 
IF ( IS3.LT . IS)  IS=IS3 
RETURN 

10  FORMAT (/1X.62HTHE  SOLUBILITY  EQUATION  COEFFICIENTS  ARE  NOT  IN  THE 
♦DATA  BASE./t1X»51HTHE  SOLUBILITY  AT  A  FIXED  TEMP  IS  THEREFORE  CALL 
♦ED./) 

END 

OVERLAYdO.l) 

PROGRAM  MODI 


PROGRAM  EXECUTES  MODEL  If  INDEX  9 


MODI  OBTAINS  THE  NECESSARY  DATA  FOR  EXECUTION  OF  SUBROUTINE 
EVDRP»  WHICH  CALCULATES  THE  RATE  OF  EVAPORATION  THAT  IS 
SPILLED  ON  THE  WATER  SURFACE 

COMMON/C /PLTYP»XBX< 150) 

INTEGER  PLTYP 

DIMENSION  AT( 20) i AV(20) ? AEV(20) t ASAVC20) 

DIMENSION  PTITL(6)»PTIT(6)fXTITL(6)fXTITLl(6)fYTITL(6)fYTITLl(6) 
EQUIVALENCE  (XBX (1)>AT(1))>(XBX(41) f AEV( 1 ) ) f (XBX(21 ) » AV( 1 ) ) 
EQUIVALENCE  (XBX(61) >ASAV(1) ) 

DATA  M0D/4H  I  / 

ODATA  (PTITL  ( I ) » 1=1 ?6)/8HV0LUME  0? 8HF  LIQUIDrSH  REHAINIr 
18HNG  VS  TI»8HME  -  MOD? 8HEL  I  / 

ODATA  (PTIT  ( I ) f 1  =  1 1 6)/8HEVAP0RAT f BHION  RATEf 8H  VS  TIME? 

18H  -  MODEL »2H  I>1H  / 

ODATA  (XTITL  (I) »I  =  lf 6)/8HELAPSED  r8HTIME. . . . 1 8H . . 

18H . .  8H . ( .8HSEC0NDS)/ 

ODATA  (XTITL1 < I ) f I  =  1 » 6 ) /8HEL APSED  »BHTINE. . . . >8H . . 

18H . .  8H . (rBHMINUTES)/ 

ODATA  (YTITL  d ) » 1*1 f 6 )/8HV0LUME  f8H  f 8HREMAININf 

18HG  i8H(M*»3)  »1H  / 

ODATA  ( YTITL1 ( I ) t 1=1 f 6)/8HEVAP0RATf 8HI0N  r 8HRATE  t 
18H  f8H(KG/SEC) flH  / 

1  CONTINUE 

CALL  TRACE(Of 8f 1 ) 

LP=6 
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OBTAIN  BATA 

CALL  BEGPR(MOD) 

CALL  FRCL( 1003>  TBOILt IS> IR) 

CALL  FRCL(100B>SURT»IS>IR) 

CALL  FRCL< 1010>AVP> IS> IR) 

CALL  FRCL( 1011 >BVP> IS>IR) 

CALL  FRCL( 1012>CVP > IS> IR) 

CALL  FRCL( 1014»XLAT > IS>IR) 

CALL  FRCL( 1021 >DENL> IS> IR) 

IF (DENL-1 . 0)20>20>30 

20  StMcTCKVitl 

DENL=1 *  01 
30  CONTINUE 

CALL  FRCL(2023>TINF>IS> IR) 

CALL  FRCL<2036>  TCRY *  IS • IR ) 

CALL  FRCL(4002»TML» ISf IR) 

VI=TML/DENL 

CALL  FRCL(4050>TIMEL>IS»IR) 

CALL  IRCL(3007 > IIPFi IS i IR) 

CALL  IRCL(3016>ITAB>IS>IR) 

CALL  EPRNT (MODi ISi IR> IL) 

IF ( IL.EG. 1 )  GO  TO  99 
IF ( IL.E0.2)  GO  TO  1 

CALL  EVDRP 
TIHE=1000000 .0 

CALL  EVDRP ( VI . BENL i SURT  > XLAT » TINF »TCRY > TIhE >  V>  TOTEV » TIMCR  > 

CALL  CRITICAL  DEPTH  CALCULATION  ROUTINE 

TMX=TINF 

IF(TCRY.GT.TMX)  TMX=TCRY 

THE  GREATER  OF  THE  WATER  TEMPERATURE  OR  THE  CARGO  TEMPERATURE 
IS  USED  IN  THE  CALCULATION 


CALL  CR1TD<AVP>BVP>CVP>TMX> DEPTH) 

UPDATE  STATE  VECTOR 

CALL  OUTPR(MOD) 

CALL  FSV(4021>TIMCR>4) 

CALL  FSV(4046»DEPTH>4) 

CALL  ENDPR(MOD) 

CALL  PAGER<3) 

WRITE(LP»46) 

CALL  ISV<2018>2>4) 

CALL  FSV(2019i 150. >4) 

CALL  FSV(4068>TB0IL?  4 ) 

ISP=0 

TIMET=TIMCR+TIMEL 

IF (TIMET .LT .600 . )  GO  TO  36 

FLOW=TML/TIMET 

ISPd 

CALL  FSV(4044>FL0W>4) 

CALL  FSV(4045»TIMET»4) 

36  CALL  ISV(2061>ISP>4) 

INTERROGATE  USER  PLOT  AND  TABLE  FLAGS 

IFUIPF.EQ.O.AND.ITAB.EO.O)  GO  TO  99 
DT*TIMCR/19. 

SET  UP  LOOP  TO  CALCULATE  PLOT  ARRAYS  OF  TIME  VERSUS  EVAPORATIO 

DO  10  Id >20 

AT( I )  =  FL0AT(I-1)*DT 

CALL  EVDRP ( VI > DENL  >  SURT  >  XLAT  >  T INF  >  TCR Y  >  AT ( I ) >  AV (I) >  AE V ( I ) >  T I MCR ) 

10  CONTINUE 

IF(IIPF.NE.l)  GO  TO  40 
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DO  16  1 1  —  1 » 2 
DO  15  1=1*20 

IF(II.EQ.l)  ASAV( I )=AV( 1 1/1000000. 

15  IF < 1 1 . EQ. 2 )  ASAV( I ) — AE V < 1 1/1000 . 

DIV=60 . 

IF(II.EQ.l)  CALL  PLTLP(PTITL* AT* ASAV*20 *XTITL * YTITL* 1 *60. *XTJTL1 1 
IFfII.EQ.7)  CALI.  PLTl.P(  PTIT » AT  *  ASAV*70*XTITL*  YTITH » 1 » 60.  *XTITL1 ) 

16  CONTINUE 
C 

C - SET  UP  OFF-LINE  PLOT 

PLTYP=6 

C 

40  IF(ITAB.NE.l)  GO  TO  99 
CALL  PAGER (01 
CALL  PAGER<8) 

WRITE  ( LF*  -41 ) 

WRITE(LP»42) 

WRITE (LP ? 43) 

DO  44  1=1*20 
RMKG=AV(I)#DENL/1000, 

EVRKG=AEV( 11/1000, 

EVRLB=AEV( 11/454. 

RMLB=AV(I)*DENL/454. 

CALL  PAGER(l) 

WRITE(LP,45)  AT (1 1 »RHKG»RMLB»EVRKG»EVRLB 

44  CONTINUE 
GO  TO  99 

410FQRMAT  (//9X.62HTABLE  OF  MASS  REMAINING  AND  EVAPORATION  RATE  VS  TI 
1ME  -  MODEL  I//) 

42  FQRMAT(7X*4HTIME.9X* 17HMASS  REMAINS*5X* 12HMASS  REMAINS .7X.9HEVAP  R 
1ATE*8X.9HEVAP  RATE) 

43  FORMAT ( 6X, 6H(SECS). 12X. 4H< KG) * 13X*4H(l.B), 12X*8H (KG/SEC). 9X*8H(LB/S 
1EC1//1 

45  FORMAT (3X*G12.4*4(5X*G12.41) 

46  FORMAT (//1X.63HTHE  FOLLOWING  PARAMETERS  ARE  ESTIMATED  IN  CASE  MODE 


1L  J  FOLLOWS-) 

100  FORMAT ( /69H  WARNING-  THE  CHEMICAL  SPILLED  HAS  A  LIQUID  DENSITY  SO 
JKCLOSF  TO  WATER/ * 66H  THAT  IT  MAY  OR  MAY  NOT  SINK.  FOR  MODEL  T*  IT  W 
♦ILL  BE  ASSUMED  THAT/*35H  IT  HAS  A  DENSITY  OF  1.01  GM/CMM3.//1 
99  CONTINUE 

CALL  TRACE (1*8*1) 

END 

SUBROUTINE  EVDRP(VI *DENL*SURT  *  XL AT  *  TINF*TCRY*TIME> V*TOTEV*TIMCR) 

***  THIS  ROUTINE  CALCULATES  THE  RATE  OF  EVAPORATION  AND  TIME  TO 
***  COMPLETELY  EVAPORATE  FOR  A  HEAVIER-THAN-WATER*  INSOLUBLE 
***  LIQUID  WITH  A  BOILING  POINT  LESS  THAN  THE  AMBIENT  TEMPERATURE. 

***  AT  TIME=TIME 

********************************************************************* 


***t************ttiNPUT  arguments  ****************** 


***  vi 
«**  surt 

***  XLAT 
***  TINF 
m  TCRY 
***  TIME 


VOLUME  OF  THE  SPILL  OF  THE  LIQUID 
SURFACE  TENSION  OF  LIQUID 
LATENT  HEAT  OF  VAPORISATION  OF  LIQUID 
TEMPERATURE  OF  THE  AMBIENT  WATER 
TEMPERATURE  OF  THE  LIQUID  SPILLED 
TIME(FROM  THE  INSTANT  OF  SPILL)  AT  WHICH 


CH**3 

DYNE/CM 
CAI./GM 
DEG  C 
DEG  C 

SECS 


THE  INFORMATION  ABOUT  EVAPORATION  RATE  IS  TO  BE  KNOWN. 
***  DENL  =  DENSITY  OF  LIQUID  SPILLED  GM/CM3 

******************  OUTPUT  ARGUMENTS  *********************** 

***  V  =  VOLUME  OF  THE  LIQUID  LEFT  IN  THE  SYSTEM  CM**3 

***  TOTEV  =  TOTAL  EVAPORATION  RATE  FROM  THE  LIQUID  GHS/SEC 

AT  TIME  ISTANT  “TIME. 

***  TIMOR  -  TIME  TO  EVAPORATE  ALL  OF  THE  LIQUID  SECS 


***********************  OTHER  PARAMETERS  ***************************** 

**x  UC  =  CRITICAL  WEBER  NUMBER  AT  WHICH  LIQUID 
BREAKS  UP  (81WC110) 

***  CD  =  DRAG  COEFFICIENT  DURING  THE  DESCENT  OF  A 
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c 

DROPlET  IN  WATER. 

c  *»* 

DEFF 

=  EFFECTIVE  GRAVITY  ( <GR*(DENL/DENU-1 . ) ) > 

CM/SEC**2 

0  #  *•* 

HR 

=  GRAVITATIONAL  ACCELERATION 

CM/SFC**2 

c  m 

PRU 

=  PRANDTL  NUMBER  FOR  WATER 

DATA  DENW. VISW.CPW.PRU.UC .CD.GR  /i .0*0.01 » S ,0.7,0.10.0.0,4. 9R0./ 
PI  =  3» 1415F2&54 
A= 1.778 

DELR0«D£NL-DENW 
GEFF »GR*  ( DENL/DENW-1 . ) 

DEL=0.056*WC 

F=SQRT(  •'K-DEL)*((l.FA*(l.-DEL)**1.5)/(l.+ft))) 
R0=S0RT((3./8.)*(WC/F**2. )*CD*(SURT/(GR*DELRO> > > 

U0=F*SQRT<<8./3. >*(GEFF/CD)*R0> 

B=CPW*(TINF-TCRY>/XLAT 

G=0ENW#U0 

REY='U0*2.*R0)//VISW/DENU) 

STANT=0,69*U . /REYtKO .  3  >  #<  1  ,/F'RW**0 . 666A7) 
CEVAP=G*STANT*AL0G(1,4B) 

EVAF0=<3./RQ>*VI*CEVAP 

CT~[fENLtRO/CEVAP 

***  CEVAF  IS  THE  EVAPORATION  RATE  PER  UNIT  AREA  AT  7ER0  TIME  FROM  A 
***  CT  IS  THE  CHATACTFRISTIC  EVAPORATION  TIME  AS  DEFINED 

m  EVAF‘0  IS  THE  TOTAL  EVAPORATION  RATE  IN  BMS/SFC  AT  ZERO  TIME. 
TIMCR=CT/0»95 
IF(TIME-TIMCR)  10.20*20 
10U=1IME/CT 

ETh=<:i.-0.?5*TOW>**(1./0.95) 

T0TEV=EVAPO*ETA**2.05 
V=VI#ETA##3 
RETURN 
)  0=0. 

TOTEV=0.0 

RETURN 

END 

QVFRLAY (10*2) 

PROGRAM  LINK1 


PROGRAM  LINK1  TS  A  MAIN  PROGRAM  FOR  OVERLAY  8.  SEGMENT  2 
AND  IS  USED  SIMPLY  TO  PASS  CONTROL  TO  THE  RATE  MODELS  K  AND  P. 

COMMON/OVCNT/MODNO  .  OVLST ( 29 ) *  SGLST ( 29 ) 

INTEGER  OVLST. SGLST 

CALL  TRACE (0.8.2) 

IF(MODNO.EQ.ll)  CALL  MODK 
IF ( MODNO . EQ . 1 5 )  CALL  MODP 
CALL  TRACE (1*8.2) 

SUBROUTINE  BBLPIS(T.H.BIFCO.C.AH.FV.FM) 


THIS  SUBROUTINE  CALCULATES  THE  RATE  OF  DISSOLUTION  OF  A 
VAPOR  BUBBLE  IN  WATER  WHEN  THE  VAPOR  IS  RELEASED  UNDER 
WATER.  THE  OUTPUT  FROM  THE  ROUTINE  IS  THE  FRACTION  OF 
INITIAL  VOLUME  OF  THE  BUBBLE  THAT  ESCAPE  INTO  THE  ATMOSPHERE 
FOR  A  GIVEN  RELEASE  DEPTH. 


INPUTS 


H 

DIFCO- 

C 


AM 

OUTPUTS 


TEMPERATURE  OF  WATER. 

DEPTH  OF  RELEASE  UNDER  WATER 
DIFFUSION  COEFFICIENT  OF  GAS  SPECIMEN 
IN  WATER. 

EQUILIBRIUM  JNTERFACIAL  CONTENTRATION  OF  GAS 
(EQUIVALENTLY  IT  IS  THE  SOLUBILITY  OF  GAS  IN 
WATER) 

MO! ELCULAR  WEIGHT  OF  THE  GAS 


DEG.C 

CMS 

CMt*2/SEC 


G-M0LES/CM**3 

GM-MOLE/GM 
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FV  ^  FRACTION  OF  THE  INITIAL  VOLUME  OF  THE  GAS 

EMERGING  FROM  THE  SURFACE  OF  THE  WATER  BODY. 
FM  =  FRACTION  OF  THE  INITIAL  MASS  OF  GAS 

RELEASED  UNDER  WATER?  EXCAPING  INTO  THE 
ATMOSPHERE. 

OTHER  PARAMETERS 


ALPHA= 
KFP  = 


OENU 

GR 

PA 

NUW 

RUNIV 

F 


RHOVI= 

RI 

NI 

RE  = 

SC 

SH 

SURT  = 
KLI  - 


A  DRAG  FACTOR  GENERAl LY  EQUAL  TO  ABOUT  30. 
TURBULENT  FLUCTUATION  VALUE  FOR  DRAG 
DUE  TO  FLOW  OF  GAS  INSIDE  THE  BUBBLE. 

(ABOUT  30) 

DENSITY  OF  WATER=1.0 
GRAVITATIONAL  ACCF.LERATI0N=?80. 

ATMOSPHERIC  PRESSURES . 0133E6 
KINEMATIC  VISCOSITY  OF  WATER=t.0E-2 
UNIVERSAL  GAS  C0NSTANT=8 .314E7 
MASS  TRANSFER  COEFFICIENT  FACTOR  WHICH 
TAKES  INTO  ACCOUNT  THE  FACT  THAT  THE 
TRANSFER  COEFFICIENT  VALUE  IS  REDUCED  DUE  TO 
THE  EFFECT  OF  THE  NEIGHBORING  GAS  BUBBLES. 
THE  INITIAL  MOLAR  DENSITY  OF  THE  VAPOR 
AT  THE  POSITION  OF  RELEASE  UNDER  WATER. 

THE  INITIAL  RADIUS  OF  BUBBLE  WHICH  IS  EQUAL 
TD  THE  CRITICAL  RADIUS  FOR  STABILITY. 

THE  NUMBER  OF  MOLES  OF  GAS  IN  THE  INITIAL 
BUBBLE. 

THE  INITIAL  REYNOLDS  NUMBER 
THE  SCHMIDT  NUMBER 
SHERWOOD  NUMBER. 

INTERFACIAL  TENSION  BETWEEN  WATER  AND  GAS. 
THE  LIQUID  SIDE  MASS  TRANSFER  COEFFICIENT 
INITIALLY 


G/CHM3 

CH/SEC*#2 

DYNES/CM**2 

CM**2/SEC 

ERG/GMMOLDEGK 


DYNES/CM 

CM/SEC 


mm*mmmmmmmmm***mm*m**mmmmm**m** 

REAL  NUW.NI.KLI »KFP 

DATA  DENW » GR. PA. NUW .RUNIV. EPSILN. ALPHA .KFP/  1,0.980. » 1 .0133E6. 1 .E 
1-2.8.314E7.0.5.0. 08?0.5/ 

SURT=70 . 0 
PI=3. 141592654 
RHOU=DENU 

F= ' 1. 5*< 1. -EPSILN >)**(l./3.) /EPSILN 

CALCULATION  OF  DIMENSIONLESS  PARAMETERS 

PSTAR=(RHOW#GR*H/PA> 

P=PAt( 1 , +PSTAR) 

DENV=P*AM/(RUNIV*(T+273. ) ) 

U=((4,/ALPHA)*<GR*SURT*>2/(DENW**2*NUW))*(DENV/DENW))**0.2 
RI-((3./KFP)*(DENW/DENV)>t$(l./3. ) t(SURT/(DENWtUtU> ) 
NI=((4./3,)*PI*RI*t3)*<DENV/AM> 

SC=NUW/DIFCO 
AI=4,*PI*RI*RI 
RE  =U*RI/NUW 

SH=0,6*(RE**0.5)*<SC**<l./3,)) 

KLI=(SH*DIFCO/RI)*F 

USTAR=(U/H)*(NI/(KLI*AI*C)> 

B=(<1,+PSTAR)/(PSTAR*USTAR>> 

PHI  =B+( 1 , -B ) tSQRT ( 1 ,+PSTAR) 

I F < PHI .LT.O.O)  PHI=0.0 

FV=PHI**2 

FM=FV/< l.+PSTAR) 

RETURN 

^dBcTION  CNSPL( IFLAG.X. Y.Z.T.W.D.UF.UT . TP.DEL.XK.E.TMT .ZMDOT.TOW) 
***  THIS  FUNCTION  IS  CALLED  BY  THE  DLIN  INTEGRATION  SUBROUTINE  . 

THIS  FUNCTION  RETURNS  THE  VALUES  OF  THF.  INTEGRAND  IN  THE  INTEGRAL 
OBTAIN  THE  CONCENTRATION  AT  ANY  POSITION  AND  TIME  WHEN  THE  SPILL 
CONTINUOUS. 

PI=3. 14159265 

GO  TO  (10.20.30) . IFLAG 
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C  ***  CONTINUOUS  SPILL  IN  STILL  WATER 

10  IF(T-TOW)  11.11.12 

11  CNSPL=0 . 

RETURN 

12  F1=(2,*ZMD0T)/(4.*PI*E)**1.5 

F2=EXP(-((X**2+Y**2+Z**2>  / (4, *E*(T-TOW> > >-XK*(T-TOW> >  /(T-T0W)**1 
1.5 

CNSPL=F1*F2 
20  RETURN 

C  ***  TIDAL  RIVER  AND  ESTURINE  CONTINUOUS  SPILL  MODELS 

30  IF(T-TOW)  31.31.32 

31  CNSPL=0. 

RETURN 

32  TT  =  T-TOW 
SIG=2.*PI/TP 

F1=ZMD0T/(W*D*SQRT(4.*PI*E>) 

F2=  ( (X-UF#TT+( UT/SIG) *<COS( SIG* (T-PEL) ) -COS (SIG* (TOW-DEL) ) ) )/SQRT 
1<4.*E*TT))**2-XK**TT 
F3=EXP(-F2)/SQRT(TT> 

CNSPL=F1*F3 

RETURN 

END 

SUBROUTINE  D I LUN( IFLAG* ICOND. ZM AS. ZMDOT » X.Y.Z. TIME. DIFCO.D.W.A.UF. 
1UT  .TP.DEL.XK.XN.C) 

C 

c  ********************************************************************** 
C***  THIS  SUBROUTINE  GIVES  THE  CONENTRATION  OF  A  WATER  MISCIBLE  LIQUID 
C  SPECIFIED  SPATIAL  POINT  AND  GIVEN  TIME.  FOR  SPILL  IN  LAKE.  RIVER  0 

C  ESTUARY.  ALL  THE  LIQUID  SPILLED  IS  ASSUMED  TO  TO  GO  INTO  SOLUTION 

C  WATER.  THE  SAME  PROGRAM  CAN  ALSO  BE  USED  FOR  DISPERSION  OF  SOLIDS 

C  ARE  NEUTRALLY  BUOYANT  OR  WHOSE  SETTLING  TIMES  ARE  LARGE  COMPARED  T 
C  TIMES. 

C 

C  THIS  SUBROUTINE  CANNOT  BE  USED  WITH  ACCURACY  FOR  CONCENTRATION  PRE 

C  FOR  THOSE  FLUIDS  WHICH  REACT  WITH  WATER  OR  WHOSE  BOILING  POINT  IS 

C  THAN  THAT  OF  THE  AMBIENT  TEMPERATURE. 

c  ********************************************************************** 


c  *********  input  arguments  **** ****** 

C  *#*  IFLAG  -  FLAG  INDICATING  WHERE  THE  SPILL  OCCURS.  (1  FOR  SPILL  IN 
C  STILL  WATER  .2  FOR  NON  TIDAL  RIVER.  3  FOR  TIDAL  REGIONS 

C  ***  ICOND  =  A  FLAG  WHICH  SPECIFIES  WHETHER  THE  SPILL  IS  CONTINUOUS  0 
C  OF  SHORT  DURATION! [INSTANT ANEOUSC )  SPILL,  THE  VALUE  OF  I 

C  0  FOR  SHORT  DURATION  SPILL  AND  1  FOR  CONTINUOUS  SPILL. 

C  ***  ZMAS  =  TOTAL  MASS  OF  LIQUID  SPILLED  GMS 

C  ***  ZMDOT  =  RATE  OF  MASS  SPILL  (TO  BE  GIVEN  ONLY  IF  IC0ND=1)  GMS 
C  ***  X.Y.Z  -  CO  ORDINATE  POSITIONS  AT  WHICH  THE  CONCENTRATION  IS  NEED 
C  THE  ORIGIN  IS  ON  THE  WATER  SURFACE  .  FOR  RIVER  SPILLS  TH 

C  X-DIRECTION  IS  IN  THE  DIRECTION  OF  FLOW  AND  Z-  DIRECTIO 

C  DEPTHWISE.  CMS 

C  ***  TIME  =  TIME  (COUNTED  FROM  INSTANT  OF  SPILL)  AT  WHICH  THE  CONCEN 
C  TION  AT  POINT  X.Y.Z  IS  TO  FE  KNOWN.  SE 

C  ***  DIFCO  =  DIFFUSION  COEFFICIENT  FOR  THE  LIQUID  IN  WATER  CM* 

C  ***  D  =  MEAN  RIVER  DEPTH  CMS 

C  **#  U  =  MEAN  RIVER  WIDTH  CMS 


ICOND  = 


i?MB9T  = 
X.Y.Z  - 


C  ***  DIFCO  = 

C  ***  D 
C  **#  U 
C  ***  A  = 

c  ***  uf 

C  ***  UT 
C  ***  TP 
C  ***  DEL 
C 

C  ***  XK 

c 

C  ***  XN 


Y-COORDINATE  OF  THE  POINT  OF  SPILL  ON  THE  WATER  SURFACE 
STREAM  VELOCITY  (  TO  BE  GIVEN  IF  IFLAG  ^2  OR  3>  CMS 
TIDAL  VELOCITY  AMPLITUDE  (FOR  IFLAG  =  3)  CMS 

TIDAL  PERIOD  SEC 

PHASE  LAG--  ESSENTIALLY  THE  TIME  FOR  THE  NEXT  HIGH  WATER 
SLACK  FROM  THE  INSTANT  OF  SPILL.  SEC 

DECAY  COEFFICIENT  (  TO  FE  GIVEN  ONLY  IF  THE  POLLUTANT  DE 
AS  PER  THE  FIRST  ORDER  DECAY  EQUATION).  1./ 

MANNING  FACTOR  OF  ROUGHNESS  FOR  RIVERS  NON-DIM 


*************  OUTPUT  ARGUMENTS  ************ 

C  ***  C  =  CONCENTRATION  OF  THE  POLLUTANT  GMS 

C  ********************************************************************** 


EXTERNAL  CNSF'L 
DIMENSION  AUX<1) 
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20 

50 

c: 

c 

60 


c 

70 

C 

74 


C 

80 

C 

C 


71-3*14159265 

IJ=0 

ISAV=IC0ND 

B=U/2. 

T  —  TIME 

IF *  ICOND)  20>20>5 
1MT=ZMAS/ZMDQT 

***  TMT  IS  THE  TIME  TO  EMPTY  CZMASC  AT  THE  RATE  OF  E7MD0TC. 

IF ( IFLAG .EQ. 2)  GO  TO  20 
IF(T-5.*TMT>  20r 1 0 r 1 0 
10  IJ=1 
IC0ND=0 
CONTINUE 

IF (ICOND) 50 >50 >100 
CONTINUE 

***  INSTANTANEOUS  SPILL  FORMULAE  ********* 

GO  TO  ( 60  >70>80) > IFLAG 

***  SPILL  IN  CALM  AND  STILL  WATER  ********* 

C=( (2.*ZMAS)/(4.*PI*T*DIFCO)**1.5)*EXP(-(X**2+Y**2+Z**2)/C4.*DIFCO 
1*T) )*£XP(-XK*T) 

IF < I J«EQ. 1 )  IC0ND= JSAV 
RETURN 

********  SPILL  INTO  A  NON  TIDAL  RIVER  ******** 

CALL  DISP(W>D>IFLAG>T>UF.UT>XN>TP>E>EX  >EY>EZ) 

TC=B**'VEY 

***  NEAR  FIELD  APPROXIMATION  *** 

F1=(2.*ZMAS)/((4.*PI*T)**1.5*SQRT(EX*EY*EZ)> 
F2=EXF(-(XK*T+(X-UF*T)**2/(4.*EX*T) ) ) 

F3=EXP(-( Y-A)**2/ (4 . *EY*T) )+EXP( - ( Y+A+W)**2/(4 . *EY*T) ) 
1+EXP\-(Y-W+A)**2/(4.*EY*T) ) 

F4=EXP(-(Z**2/(4.*EZ*T)))+EXP(-( (Z-2.*D)**2/(4.*EZ*T) ) ) 
F4=F4+EXP<-((Z+2.*D)**2/<4.*EZ*T)>) 

C=F1*F2*F3*F4 

RETURN 

*******  SPILL  INTO  TIDAL  REGIONS  OF  A  RIVER  ********* 

CALL  DISP(W>D>IFLAG>T>UF>UT>XN>TP>E>EX  >EY>EZ) 

g j  ^PJ  /jp 

****  J'  THE  CROSS  SECTIONAL  MEAN  CONCENTRATION  IS  CALCULATED  ASSUMING 
THE  RIVER  OSCILLATION  VELOCITY  TO  BE  SUNUSOIDAL. 

Fl=  ZMAS  /(W*D*3QRT (4 .*PI*E*T) ) 

F2=EXP(-XK*T) 

F31=X-(UF*T) 

F32=(UT/SIG)*(C0S(Sri*(T-DEL))-CnS(SIG*DEL)> 

F33= ( F31 +F32) /SORT ( 4 . *F*T ) 

F33=ABS(F33) 

IF (F33.GT .9.3)  C=0.0 
IF (F33.GT .9*3)  RETURN 
F3=  ./EXP(F33*F33> 

C=F1*F2*F3 

IF(IJ.EO.l)  ICOND=ISAV 
RETURN 


C  *******  CONTINUOUS  SPILLS  **************** 

C  ****  IN  THE  FOLLOWING  PROGRAM  ON  THE  CONTINUOUS  SPILLS  WE  ASSUME  THAT 
C  »***RATE  OF  SPILL  CZMDOTC  IS  A  CONSTANT. 


10 

C  ** 
110 


n; 


113 


C  *** 

r: 

)  30 
121 


GO  TO  ( 1 10> 120> 130) > IFLAG 
CONTINUOUS  SPILL  IN  A  STILL  WATER  REGION  ***** 

EPS=0. 1 
NDIM=25 

IF(T-TMT)  112> 1 12> 113 

CALL  DLIN( IFLAG>X> Y>Z> T >UF>UT>TP> DEL» W>D>XK>DIFCO>TMT >ZMDOT>0.0> 

IT  >EPS>NDIM>CNSPL>C> IER> AUX  > 

RETURN 

CALL  DL1N(IFLAG>X>Y>Z>T>UF»UT>TP>DEL>W>D>XK>DIFC0>TMT>ZMD0T>0.0» 
1TMT  >EPS>NDIM>CNSPL>C>IER>AUX) 

RETURN 

SPILL  IN  A  NON  TIDAL  RIVER  ***>  WE  ASSUME  THAT  THE  LONGITUDINAL 
SION  IS  SMALL.  THE  CONCENTRATION  GIVEN  IS  THE  CROSS  SECTIONAL  AVE 

c=o. 

IF (X-UF*T)  121 > 121 > 126 

CALL  DISP ( ll> D>  IFLAG > T>UF>(JT >XN>TP>E >EX  >EY>EZ) 

:C=B**2/EY 
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XC=UF*TC 

IF (X-0.3*XC>  1 22  ^ 1 22  f 1 23 
C  ****  NEAR  FIELD  APPROXIMATION 
122  Fl=ZMD0T/(2.*PI*X*SQRT(EY*EZ) ) 

TON =X/UF 

F2=EXP<-((Y-A)**2/(4.*EY*TCN>mEXP<-(mA+W)**2/<4.*EY*TCN)) ) 
1FEXP<-<(Y-W+A)**2/(4.*EY*TCN))) 

F3*EXP(-<Z**2/(4.*EZ*TCN)))+EXP(-((Z-2.*D)**2/<4.*EZ*TCN)>> 

TSAV=(X/UF)+TMT 
IF(T.GT.TSAV)  C=0.0 
RETURN 

C  ***  FAR  FIELD  APPROXIMATION  ********* 

123  0MG=SQRT(UF**2+4,*XK*E> 

F1=ZMDOT/(W*D*OMG*2.) 

G 1 = 1  * 

G2=l . 

IF (T-TMT) 125, 125*124 

124  G1=ERF(  (X+OMG*(T-THT )  ) /SORT ( 4. *E*( T-TMT) ) ) 

G2=ERF ( <X-OHG*( T-TMT ) ) /SORT (4 . *E*( T-TMT) ) ) 

125  F2=(ERF((X+0MG*T)/SQRT(4.tE*T)>-Gl)*EXP( (X*0.5/E)*(UF+OMG) ) 
F3=<ERF<(X-0MG*T)/SQRT<4.*E*T>)-G2>*EXP<<X*0.5/E)*(UF-DMG)) 
C=F1*(F2-F3> 

RETURN 

CONTINUOUS  INJECTION  IN  TIDAL  RIVERS  ******** 


126 

C  **** 


130 

131 


132 


133 


C 

C 

c 

c 

C 


CALL  D ISP ( W, D » IFLAG »T .UF.UT.XN.TP.E.EX  .EY.EZ) 

ESP=0.01 

?fW:?MT)  132,132.133 

CALL  DL I N  <  I FL  AG » X ,  Y ,  Z » T ,  UF » UT ,  TP » DEL ,  W ,  D ,  XK » E  .TMT.ZMDOT.O.O, 

1T.EPS.NDIM.CNSPL.C. IER.AUX  > 

RETURN 

CALL  DLIN( IFLAG. X. Y, Z. T ,UF,UT ,TP,DEL,U. D.XK.E  .TMT.ZMDOT.O.O, 

1TMT. EPS. NDIM.CNSPL.C, IER.AUX) 

RETURN 

END 

SUBROUTINE  DLIN<IFLAG,XX»YY»ZZ,T,UF,UT,TP,DEL,W,D,XK,S,TMT,ZMDOT, 
1XL. XU, EPS, NMAX.FCT.Y. IER.AUX) 

THIS  ROUTINE  PERFORMS  AN  INTEGRATION  OF  A  CONCENTRATION  EQUATION 
WHICH  GIVES  THE  CONCENTRATION  AT  SOME  DOWNSTREAM  LOCATION  FOR 
CONTINUOUS  SPILLS  OF  A  CHEMICAL  INTO  A  TIDAL  REGION. 

THE  CODING  USED  WAS  TAKEN  ALMOST  VERBATIM  FROM  A  SAMPLE  PROGRAM 
GIVEN  IN  THE  BOOK  -  APPLIED  NUMERICAL  METHODS  -  BY  CARNAHAN, 
LUTHER.  AND  WILKES  PUBLISHED  BY  JOHN  WILEY  AND  SONS,  INC.  SEE 
THE  SUBROUTINE  NAMED  TROMB  ON  PAGF  96. 

DIMENSION  TAI20.20) ,AUX(1) 

NMAX=10 

IF ( XU.GT .6000. )  NMAX=11 

UMAX  IS  AN  INTEGER  WHICH  DEFINES  THE  ACCURACY  OF  THIS  INTEGRATION. 
IT  WAS  ARBITRARILY  SET  TO  THE  VALUES  SHOWN  TO  PROVIDE  A  REASONABLE 
DEGREE  OF  ACCURACY  WHILE  USING  A  REASONABLE  AMOUNT  OF  COMPUTATION 
TIME.  THIS  COMPROMISE  CAN,  HOWEVER,  SOMETIMES  RESULT  IN  CURVES 
WHICH  CONTAIN  ONE  OR  MORE  ERRATIC  POINTS, 

JMAX=NMAX+1 

H=XU-XL 

TA(1,DS!0.5*H*(FCT(IFLAG,XX,YY»7Z,T,W»D»UF,UT,  TP.DEL.  XK.S.  TMT , 
1ZMD0T .XD+FCT ( IFLAG, XX? YY»ZZ,T,W,D,UF»UT ,TP, DEL.XK.S.TMT .ZMDOT ,XU) 
2) 

DO  2  N=1 »NMAX 

TA(N+1,1)=0.0 

FR«H/2.0**N 

IMAX«2**N-1 

DO  1  I- 1.IMAX.2 

TS*FLOAT(I)*FR+XL 

1'lifi■fM^iii*^i)N+1,l)+FCT<IFLftG,xx,YY’zz’T’Mrn,UF,UT,TF,,nEL,XK's, 

2  TA(N+l,l)*TA(N,l)/2.0+H*TA(N41,l)/2.0**N 
DO  3  J*2, JMAX 
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NXM=NMAX- J+2 
FORJ=4,0*<( J-l) 

DO  3  N«1»NXM 

3  TA(N»  J) =<F0RJ*TA(N+1 . J-J >-TA(N. J-l ) >/<F0RJ-l .0) 
Y=TA( 1 .UMAX) 

RETURN 

END 

SUBROUTINE  MODK 


tmttttnmtmmumtmutmmtuttttmmtttttumttttm 

THE  DECISION  PROCESSES  WITHIN  SUBROUTINE  MODK  ARE  EXCEEDINGLY 
COMPLEX.  A  DETAILED  DISCUSSION  IS  THEREFORE  PRESENTED  IN  THE 
FOLLOWING  TO  CLARIFY  THE  VARIOUS  BRANCHINGS  WHICH  TAKE  PLACE 
DURING  ITS  EXECUTION. 

MODEL  K  IS  USED  TO  ASSESS  THE  HAZARDS  OF  SLIGHTLY  SOLUBLE 
CHEMICALS  WHICH  HAVE  A  BOILING  POINT  LESS  THAN  THE  AMBIENT 
TEMPERATURE.  WHEN  SUCH  A  SUBSTANCE  IS  OF  FINITE  SOLUBILITY  AND  IS 
RELEASED  UNDER  WATER.  SUBROUTINE  BBLDIS  IS  USED  TO  DETERMINE 
THE  AMOUNT  OF  THE  SUBSTANCE  DISCHARGED  WHICH  GOES  INTO  SOLUTION 
AND  THE  AMOUNT  WHICH  IS  FVOLVED  AS  VAPOR  FROM  THE  SURFACE  OF  THE 
WATER.  THE  PORTION  WHICH  GOES  INTO  SOLUTION  IS  THEN  USED  IN 
MODEL  P  10  DETERMINE  WATER  POLLUTION  HAZARDS.  THE  AMOUNT 
OF  VAPOR  IS  TRANSFERRED  TO  MODELS  M  AND  N.  AND  SUBSEQUENTLY  TO 
MODELS  Cl  AND  C2.  FOR  THE  DETERMINATION  OF  VAPOR  DISPERSION 

!P«i  mm.  limns  mY 

FEET  UNDER  WATER  AND  IS  SLIGHTLY  OR  MODERATELY  SOLUBLE  IN  WATER9. 
WHEN  THE  SUBSTANCE  IS  RELEASED  ON  OR  NEAR  THE  SURFACE  OF  THE  WATER 
BODY  AND/OR  IS  COMPLETELY  MISCIBLE  IN  WATER.  BBLDIS  CANNOT  BE 
USED.  IN  THESE  CASES.  IT  IS  ASSUMED  FOR  THE  PURPOSE  OF  EXECUTION 
OF  MODEL  P.  THE  WATER  DISPERSION  MODEL.  THAT  ALL  THE  LIQUID  GOES 
INTO  SOLUTION.  THE  AMOUNT  OF  VAPOR  EVOLVED  IS  ESTIMATED  IN  MODEL 
N,  THE  VAPOR  DISPERSION  MODEL. 

THE  DECISION  PROCESS  IS  COMPLICATED  BY  TWO  FACTORS.  ONE  OF  THESE 
CONCERNS  THE  PROPERTY  FILE  TAPE  SINCE  IT  LISTS  THE  SOLUBILITY  DATA 
FOR  A  SUBSTANCE  AS  MISSING  IF  THE  CHEMICAL  IS  COMPLETELY 
MISCIBLE  IN  WATER.  THIS  WAS  DONE  BECAUSE  THE  TRUE  VALUE  IS_  _ 
INFINITY  AND  CANNOT  BF  PROPERLY  REPRESENTED.  ITS  CONSEQUENCE  IS 
THAT  ACCESS  TO  THIS  DATA  DOES  NOT  ALLOW  ACCURATE  DETERMINATION  OF 
WHETHER  THE  SUBSTANCE  IS  COMPLFTELY  MISCIBLE  OR  IS  OF  UNKNOWN 
FINITE  SOLUBILITY.  TO  ACCOUNT  FOR  THIS  PREDICAMENT.  THE  MODEL 
ASSUMES  THE  SUBSTANCE  IS  COMPLETELY  MISCIBLE  IN  WATER  AND 
PROCEEDS  AS  DESCRIBED  ABOVE. 

THE  OTHER  PROBLEM  ARISES  FROM  THE  DENSITY  OF  THE  SUBSTANCE, 

IF  THE  DENSITY  IS  GREATER  THAN  WATER.  THE  SUBSTANCE  IS  RELEASED 
ON  OR  NEAR  THE  BOTTOM  OF  THE  WATERBODY.  AND  THE  WATER  DEPTH  IS 
SUCH  THAT  HYDROSTATIC  PRESSURE  DOES  NOT  ALLOW  THE  CHEMICAL  TO 
BOIL  (CASE  1).  VAPOR  BUBBLES  WILL  NOT  REACH  THE  SURFACE  AND  ALL 
THE  CHEMICAL  WILL  EVENTUALLY  DISSOLVE.  THE  DEPTH  AT  WHICH  THE 
LIQUID  WILL  NOT  BOIL  IS  CALLED  ITS  CRITICAL  DEPTH.  IF  THE 
SUBSTANCE  IS  DENSER  THAN  WATER  AND  IS  RELEASED  AT  A  DEPTH  LESS 
THAN  ITS  CRITICAL  DEPTH  IN  A  UATERBODY  WHICH  IS  DEEPER  THAN  ITS 
CRITICAL  DEPTH  (  CASE  2).  SOME  OF  THE  SUBSTANCE  WILL  BOIL  OFF  AND 
FORM  VAPOR  BUBBLES  WHICH  HEAD  TOWARDS  THE  SURFACE  WHILE  THE  REST 
SINKS  TO  A  DEPTH  AT  WHICH  IT  CANNOT  BOIL.  IF  THE  CHEMICAL  IS  LESS 

DENSE  THAN  WATER  AND  IS  RELEASED  AT  ANY  POINT  UNDER  WATER  (CASE  3) 

IT  WILL  EITHER  IMMEDIATELY  BEGIN  TO  BOIL  OR  RISE  UNTIL  IT  REACHES 
A  DEPTH  AT  WHICH  IT  CAN  BOIL. 

FOR  CASE  1.  MODEL  K  ASSUMES  THAT  ALL  THE  CHEMICAL  INSTANTLY 

DISSOLVES  IN  THE  WATER  AND  EXECUTES  MODEL  P.  THE  USERS  MANUAL 

NOTES  THAT  THE  USER  MAY  WISH  TO  EXECUTE  MODEL  X  FOR  MORE  ACCURATE 
ANSWERS  IF  THE  SUBSTANCE  IS  ONLY  SLIGHTLY  SOLUBLE. 

FOR  CASE  2.  IT  IS  ASUMED  THAT  THE  CHEMICAL  NEITHER  RISES 
NOR  SINKS.  ALTHOUGH  THIS  ASSUMPTION  TENDS  TO 

nmk’MHF  ftKt 

COULD  NOT  BE  ENVISIONED. 

FOR  CASE  3.  IT  IS  ASSUMED  THAT  THE  CHEMICAL  IS  RELEASED  AT  A 

6Ri5T«LRfilIHto  mil  fiMcfHyili?Sc?liET0 

SURFACE, 

Hmmtmummtmmtmmmmttmmmtmmnmmu 
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DATA  M0D/4H  K  / 

CONTINUE 

LP=6 

1R=Q 

IS=£ 

C=0,1 

OBTAIN  NECESSARY  DATA 

CALL  BEGPR ( MOD) 

CALL  FRCL(2021»H»ISiIR) 

B=10.*12.*2.54 
IF(H.LT.B)  GO  TO  5 
CALL  FRCL(1002i ANiIS»IR) 

CALL  FRCL(1003»TBfIS»IR) 

CALL  FRCL(1010>AVP,IS»IR> 

CALL  FRCL(1011»BVP»IS»IR) 

CALL  FRCL(1012»CVPf ISjIR) 

CALL  FRCL( 1021 1 DENL • IS »  XR > 

CALL  FRCL< 1025»TC»IS» IR) 

CALL  FRCL ( 2004 i TEMPi IS i IR) 

CALL  FRCL ( 2007  »SP AMT > IS* IR ) 

CALL  FRCL (2023 » T» IS > IR) 

CALCULATE  DIFFUSION  COEFFIENT  OF  CHEMICAL  IN  WATER 

CALL  PAGER<4) 

WRITE(LP» 10) 

CALL  CDIFU(AMrDENLrTrTCrTBrDIFCO) 

CALL  FSV(2043fDlFC0f4> 

CALL  FRCL ( 2043 rDIFCOi IS »IR) 

CALL  ROUTINE  SOLUB  TO  FIND  SOLUBILITY  OF  CHEMICAL  AT  THE  WATER 
TEMPERATURE 

SOLUB  CALLS  DATA  OF  FIELD  NUMBERS  1026>1028>  AND  1029. 

CALL  SOLUB<TrCSAT,IS»IR) 

C=CSAT/( lOO.tAM) 

IF(C.NE.O.O)  GO  TO  5 
CALL  PAGER(5> 

WRITE(LP»70) 

IF (C.EQ.O.O)  GO  TO  5 
CALL  EPRNT(MOD»IS» IR j IL) 

IF(IL.EQ.l)  GO  TO  99 

IF (C.EQ.O.O)  GO  TO  31 
TMX=TEMP 

IF(T.GT.TMX)  TMX*T 

CALL  CRI TD ( AVP >  BVP . CVP r  TMX r DEPTH ) 

CALL  OUTPR(MOD) 

IF(DENL.GE.l.O)  GO  TO  6 

iUE’Hiffiir  50  T0  4 

WRITE(LP»BO) 

IF (DENL. LT. 1.0. AND. H.GE. DEPTH)  H»DEPTH 

IF(H.LT.B)  GO  TO  8 

CALL  BBLDIS(T»H»DIFCO*CfAM»FVfFM) 

IF(DEPTH.LT.H)  FM=0.0 
IF(FM.NE.O.O)  GO  TO  7 
CALL  PAGER(4) 

WRITE(LP>20) 

AMTUP=FM*SPAMT 
CALL  ISV(2029»0»4) 

Ball  £lvlii$i^M$vPr4> 

AMTLQ=SPAMT-AMTVP 
CALL  FSV(4002»AMTLQ»4) 

^I:laf5Ij(48S§W,4) 

CALL  FSV(404£f DEPTH»4) 

CALL  FSV( 406B»TB»4) 


149 


nonnnn 


CALL  PAGER(4) 

WRIT£(LP,40) 

GO  TO  50 
8  CALL  PAGER(6) 

WRITE(LP,90> 

CALL  ISV(2029»0»4> 

CALL  ISV(2084»1 ,4) 

CALL  FSV(400i,0.0,4> 

CALL  FSV(40Q2»SPAMT ,4) 

VOL=SPAMT/DENL 
CALL  FSV(4003,V0L»4) 

CALL  FSV(4046,DEPTH»4) 

CALL  FSV(4068,TB»4) 

WRITE(LP»40) 

GO  TO  50 

30  CALL  PAGER(6> 

WRITE(LP,60) 

31  CALL  PAGER<4> 

CALL  ISV(2084,1,4) 

IF(C.EQ.O.O)  CALL  FSV<4001»0.0,4) 

IF(C.EQ.O.O)  CALL  FSV(4002»SPAMT,4) 

VOL=SPAMT/DENL 

IF(C.EQ.O.O)  CALL  FSV<4003» V0L.4) 

WRITE(LP>40) 

50  Eitt  ^EPr(MOD) 

99  RETURN 

10  FORHAT ( /66H  THE  DIFFUSION  COEFFICIENT  DF  THE  CHEMICAL  IN  HATER  IS 
1CALCULATED./) 

20  FORMAT </64H  THE  CHEMICAL  IS  RELEASED  AT  TOO  GREAT  A  DEPTH  FOR  VAPO 
1R  BUBBLES/22H  TO  REACH  THE  SURFACE./) 

40  F0RMAT(/53H  MODEL  P  IS  EXECUTED  TO  DETERMINE  THE  HATER  POLLUTION/ 
154H  HAZARDS  OF  THE  CHEMICAL  HHICH  DISSOLVES  IN  THE  HATER./) 

60  FORMAT </62H  SINCE  THE  RELEASE  IS  ON  OR  NEAR  THE  SURFACE,  AND  A  MOD 
1EL  D0ES/59H  NOT  EXIST  HHICH  ESTIMATES  THE  PROPORTION  OF  CHEMICAL  U 
2H1CH/61H  DISSOLVES.  IT  IS  ASSUMED  THAT  IT  ALL  DISSOLVES  FOR  EXECUT 
3I0N/12H  OF  MODEL  P./> 

70  FORMAT (/54H  SUFFIT'ENT  DATA  DOES  NOT  EXIST  TO  ALLOH  DETERMINATION/ 
151H  OF  HHETHER  THE  CHEMICAL  IS  FULLY  MISCIBLE  IN  HATER/54H  OR  OF  F 
2INITE  SOLUBILITY.  IT  IS  THEREFORE  ASSUMED  THAT/35H  ALL  THE  LIQUID 
3RELEASED  DISSOLVES,) 

80  FORMAT ( /58H  SINCE  THE  CHEMICAL  IS  LESS  DENSE  THAN  HATER  AND  HILL  R 
1 ISE/54H  TO  A  DEPTH  AT  HHICH  IT  CAN  BOIL.  THE  DEPTH  OF  RELEASE/38H 
3UAS  CHANGED  TO  BE  ITS  CRITICAL  DEPTH./) 

90  FORMAT! /65H  SINCE  THE  CRITICAL  DEPTH  IS  LESS  THAN  10  FEET  DEEP.  TH 
IE  SPECIFIC/69H  AMOUNT  OF  CHEMICAL  HHICH  DISSOLVES  IN  THE  HATER  CAN 
2N0T  BE  ESTIMATED. /67H  IT  IS  THEREFORE  ASSUMED  THAT  ALL  LIQUID  HISS 
30LVES  FOR  EXECUTION  0F/25H  HATER  POLLUTION  MODEL  P./> 

END 

SUBROUTINE  MODP 

SUBROUTINE  MODP  OBTAINS  THE  NECESSARY  DATA  FOR  EXECUTION  OF 
SUBROUTINE  DILUN.  WHICH  CALCULATES  THE  CONCENTRATION  OF  A 
HATER-MISCIBLE  LIQUID  AT  ANY  SPECIFIED  SPATIAL  POINT  AND 
GIVEN  TIME  FOR  A  SPILL  IN  A  LAKE,  RIVER,  OR  ESTUARY. 

C0MMON/C/PLTYP, XBX< 150) 

INTEGER  PLTYP 
LOGICAL  YESNO 

DIMENSION  ASAV(40) » ASAVT < 40) 

DIMENSION  AT(40) ,AC(40) , AXD(40) ,ATIM(40) ,AC0NC(40»2) 

DIMENSION  PTITL(6) »XTITL(6> ,XTITL1 (6) ,YTITL<6) 

EQUIVALENCE  (XBX(61 ) ,X) , <XBX<62> ,Y> , (XRX<63> ,Z) 

EQUIVALENCE  <XBX<66) ,UX> , <XBX<67) .TMINX) , <XBX<68) » ACONC( 1 , 1 ) ) 

oB«3  WHE  »6)/8HC0NCENTR,8HATI0N  VS.8H  TIME  AT, 

18H  A  FIXED, 8H  POINT  -,8H  MODEL  P/ 

ODATA  (XTITL  ( I ) , 1=1 , 6 ) /8HEL APSED  .8HTIME  FRO.BHM  START  , 

MR  RnkRii;i:i;ilWI!nB/  .BHTIME  FR0.8HM  START  , 

18H0F  SPILL, 8H . ,8H.  (HOURS)/ 

ODATA  ( YTITL  (I) ,1=) ,6)/BH  CONCE » 8HNTRATI0N»8H  AT  P, 


v 


nnnn  noo  orj  non  oo 


18HCIINT  XYZflH 
i  CONTINUE 
IR=0 
1S=6 
LP  =  * 


p5H(PPM)/ 


OBTAIN  NECESSARY  DATA 


CALL  BEGPR(M0B 
CALL  IRCL(2028 
CALL  IRCL(2029 
IF(IFLAG.EQ.l) 
IF< IFLAG. EQ. 1 ) 
CALL  FRCL( 1004 
IF(IFLAG.EQ.l) 
IFdFLAG.EQ.  1 ) 
IFdFLAG.EQ. 1) 
CALL  FRCL  <  2039 
CALL  FRCL ( 2040 
CALL  FRCL(204 1 
CALL  FRCL(2042 
IF ( IFLAG. NE .3 ) 
IF ( IFLAG.NE » 1 ) 
IF ( IFLAG. NE . 1 ) 
IF ( IFLAG.NE* 1) 
IF1!  IFLAG.NE. 3) 
CALL  FRCL (2048 
CALL  FRCL (2049 
CALL  FRCL (2050 
100  CONTINUE 

CALL  FRCU2051 
IF<  IFLAG. NE.l) 
CALL  FRCL< 4002 
IF< ICOND.EQ. 1 > 


» IFLAG' IS> IR) 

» ICONDfIS»IR) 
CALL  FRCL(1002 
CALL  FRCL (1003 
'DENL'IS' IR) 
CALL  FRCL( 1021 
CALL  FRCL( 1025 
CALL  FRCL (2023 
»X*IS*IR) 

»Y'IS» IR) 

>Z.ISf IR) 

.  TIME* IS* IR) 
CALL  FRCL ( 2044 
CALL  FRCL ( 2045 
CALL  FRCL(2046 
CALL  FRCL(2047 
GO  TO  100 
rUT.IS.IR) 

» TPi IS> IR) 
»DEL»IS»IR) 


» AM» IS» IR) 
'TBDIL'IS'IR) 


'DENLB'IS? IR) 
» TCRIT » IS»  IR) 
'THAT » IS'IR) 


iDtISrIR) 
'W' IS' IR) 
'A' IS' IR) 

» UF» IS» IR) 


*XK,IS.IR) 

CALL  FRCL ( 2052 'XN' IS' IR) 
'ZHAS' IS' IR) 

CALL  FRCL ( 4049 »ZHD0T» IS » IR) 


CALCULATE  DIFFUSION  COEFFICIENT  OF  CHEMICAL  IN  WATER. 


IF ( IFLAG.NE. 1 )  GO  TO  30 
CALL  PAGER (3) 

URITE<6'40) 

CALL  CD IFW ( AM » DENLB i TWAT 'TCRIT 'TBOIL'DIFCO) 

DIFC0=BIFC0*1000.0 

CALL  FSV(2043iDIFC0»4) 

CALL  FRCL ( 2043 'DIFCO' IS' IR) 

30  CONTINUE 

CALL  IRCL  ( 3008 » I  F’F'F '  I S '  I R ) 

CALL  IRCL(3015'ITAB'IS'IR) 

IF ( ITAB.EQ.O, AND. IPPF .EQ.O)  GO  TO 
CALL  FRCL(20: 

1  CALL  EPRK - 

IF(IL.EO.l)  GO  TO  99 
IF(IL.EG.2)  GO  TO  4 


37»TMXPi IS» IR) 
UD'IS'IR'IL) 


CALL  DILUN 

CALL  D1LUN(IFLAG'IC0ND*ZMAS»ZMD0T.X'Y,Z»TIME»DIFC0'D»W»A'UF 
1  UT  jTPjDEL'XK'XN'CNTR) 


UPDATE  DATA  BASE 


CALL  OUTPR(MOD) 
IF(CNTR.GT.DENL)  CNTR=DENL 
CALL  FSV<4022'CNTR'4> 
CS=CNTR*1 000000.0 
CPPM=CS/DENL 
CALL  PAGER (2) 

WRITE(LP»31)  CPPM'CS 
CALL  ENDPR(MOD) 


jpLg^AT|TggTA  OF  CONCENTRATION  VS  TIME  AT  FIXED  POINT 


IST0P=0 


C-J  au 


IF1IPPF.E8.0. AND. ITAB.E8.0)  GO  TO  99 
IF ( IPPF.E8.2. AND. ITAB.EQ.2)  GO  TO  70 
IF  (IFLAG,E0.2)  GO  TO  25 
TMAXI=THXP 
TMINI=60, 

GO  TO  20 
25  TMX=X/UF 

RH=W*D/(2.*D+H) 

TYM=DIST/UF 
TMAXI=TMX+(TYM/2. ) 

TMINI=TMX-(TYM/2.) 

IF1TNINI.LT.60.)  TMINI=60. 

20  DT=(TMAXI-THINI )/39. 

DO  10  1=1.40 

AT ( I )=<FL0AT ( 1-1 )*DT) +TMINI 

CALL  DILUN1 IFLAG. IC0ND.7MAS.ZMD0T .X.Y.Z. AT ( I) .DIFCO.D.U. A.UF » 

1  UT.TP.DEL.XK.XN.AC(I)) 

10  CONTINUE 

IF(IFLAG.EQ.2)  GO  TO  13 
IF<AC(37),GT.0.0>  GO  TO  13 
1=36 

IF(ISTOP.EO.l)  GO  TO  13 
12  IF( AC( I) .GT .0.0 )  GO  TO  11 
1  =  1-1 

IF(I.EQ.l)  GO  TO  13 
GO  TO  12 

11  TMAXI=AT(I+1) 

IST0P=1 

GO  TO  20 

GENERATE  PLOT  OF  CONCENTRATION  VS  TIME  AT  USER  SPECIFIED  POINT 


13  CONTINUE 
DO  15  1=1 » 40 

ASAVl I >=AC ( I >*1000000 ./DENL 

IF ( ASAV < I ) ,  GT , 1000000 , >  ASAV < I >  =1000000 . 

15  ASAVT < I >=AT< I ) /60  i 
IDC=0 

IF(IPPF.E8.3)  IDC=1 
IF(IPPF.EO.l)  IDC=1 
IF(IOC.NE.l)  GO  TO  70 

CALL  PLTLPCPTITL  .ASAVT. ASAV.40.XTITL.YTITL  . 1 .60. .XTITL1 > 


. SET  UP  OFF-LINE  PLOT 

PLTYP=7 

11=0 

JJ=20 

UX=UF 

TM7NX=TMINI 
DO  16  1=1.40.2 
11=11+1 
JJ=JJ41 
XBX( II )*AT (I > 

16  XBX(JJ)=AC(I) 

GENERATE  TABLE  OF  CONCENTRATION  VS  TIME  AT  USER  SPECIFIED  POINT. 
70  IF(ITAB.EQ.2>  GO  TO  80 

iStfWBiSS  " T0  90 

CALL  PAGER (2) 

URITE<6»71> 

CALL  PAGER(3) 

URI’E  <6.72) 

CALL  PAGER<2> 

WRITE16.73) 

i 5J8enl 

CALL  PAGER(l) 

WR I TE ( LP . 75 )  ASAVT ( I ) . ASAVl I > . CS 
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74  CONTINUE 
CALL  PAGER(2) 

CALCULATE  DATA  FOR  A  TABLE  OF  CONCENTRATIONS  VS.  TINE  AND 
DISTANCE*  AS  APPROPRIATE*  FOR  A  NON-TIDAL  FLOWING  RIVER. 

80  IF ( ITAB.LE . 1 . AND.IPPF .LE . 1 )  GO  TO  69 
IF ( IFLAG.EQ, 2)  GO  TO  5 
CALL  PAGER(O) 

CALL  PAGER (3) 

WRITE(LP*49> 

5  IF( IFLAG.NE.2)  GO  TO  99 
TNINI=60. 

YM=A 

ZM=0.0 

DT=<THXP-THINI)/39. 

XNINI=UF*TNINI 

DT=ABS(DT) 

DO  60  J=1  *2 
DO  50  1=1*40 

ATIH<I)=THINI+<FLOAT<I-l)*DT> 

AXD( I >=UFIATIN( I ) 

IF<ICOND.EQ.l)  ATIN ( I)=ATIN< I)+(ZHAS/(ZND0T*2. ) ) 

WABOVE  LINE  INSERTED  BY  R.G.  POTTS  ON  3  NOV  1978 
MSETS  TINE  TO  OBTAIN  NAX  CONCENTRATION  AT  LOC  AXD(I) 

CALL  DILUN(IFLAG*ICOND.ZNAS,ZNDOT*AXD(I)*YN»ZH*ATIN(I)»DIFCO»D*U. 
1A*UF*UT*TP*DEL* XK*XN* AC0NC( I  * J ) ) 

50  CONTINUE 
ZN=D 

60  CONTINUE 

GENERATE  TABLE  FRON  DATA  CONPUTED  ABOVE 

CALL  PAGER<0> 

CALL  PAGER(4) 

IF(ICOND.EQ.O)  WRITE<6.2000) 

20000FORNAT  (/12X.53HTABLE  OF  CONCENTRATION  VS  TINE  AND  DISTANCE  -  NODE 
1L  P//) 

IF(ICOND.NE.O)  WRITE(6,2010) 

2010  FORNAT  (/11X.44HTABLE  OF  CONCENTRATION  VS  DISTANCE  -  NODEL  P//> 

)  WRITE(6,2020) 

20200FORNAT  UX*2(4X*10HD0WNSTREAN> .6X.8HELAPSED  *?(2X*13HC0NCENTRATI0N 
1 )/2(6X,8HDISTANCE) *8X, 4HTINE*7X* 10HAT  SURFACE. 4X, 11H0N  RIVERBED/ 

2  6X*8H(NETERS) *7X*6H(FEET) *7X*9H(NINUTES) *2(4X* 10H(NG/LITER) )/> 
IF(ICOND.NE.O)  WRITE(6*2030) 

20300F0RNAT  aX*2(4X,10HD0WNSTREAN) *2X*2(2X»13HC0NCENTRATI0N)/2(6X*8HDI 
1 STANCE) *7X* 10HAT  SURFACE*4X*11H0N  R I VERBED/6X * 8H < NETERS ) * 7X * 6H ( FEE 
2T).4X.2(4X,10H<NG/LITER))/> 

DO  65  1=1.40 
XNET=AXIKI)/100. 

TNNS=ATIN(I)/60. 

XFT=AXPiI)/(2,54<12. ) 

IF( ACuNC( I . 1 ) ,GT , DENL)  ACONC( I . 1 )=DENL 
IF (ACONC ( I *2) <GT ,DENL )  ACONC(I *2)=DENL 
T0PC=AC0NC( I  *  1)41000000. 

ACONC ( I « 1 ) =TOPC/DENL 
B0TC=AC0NC< I *2)41000000. 

ACONC ( I *2)=B0TC/DENL 
CALL  PAGER ( 1 ) 

IF(ICOND.EQ.O)  WRITE(6*2040)  XNET.XFT.TMNS.TOPC.BOTC 
2040  FORNAT  (1X*5(4X*G10.4) ) 

IF ( ICOND.NE .0)  URITE(6.2050)  XHET.XFT.TOPC.BOTC 
2050  FORNAT  <1X,2<4X*G10.4) *2X*2(4X*G10.4)) 

65  CONTINUE 
CALL  PAGER(5) 

WRITE<6* 2060) 

20600F0RNAT  (/5X.63HN0TE!  TABLE  GIVES  CONCENTRATIONS  AT  SURFACE  AND  ON 

3RIVERBED  SHIFTED  FRON  THE/5X.37HRIVER  CENTERLINE  BY  THE  SPILL  OFFS 
4ET . ) 


153 


v 


noon  ooo  oonooo 


69  CONTINUE 
99  CONTINUE 
RETURN 

31  FORMAT (/1X,35HTHIS  CONCENTRATION  IS  EQUIVALENT  TO,  1  X*G10.4,  1  X»7HPP 
IN  AND,1X,G10.4,1X,9HMG/LITER. > 

40  FORMAT ( /65H  THE  DIFFUSION  COEFFICIENT  OF  THE  CHEMICAL  IN  HATER  IS 
1CALCULATED/ ) 

49  FORMAT (  /1X,43HTABL£  OF  CONCENTRATION  VS  TIME  AND  DISTANCE/1X, 
130HN0T  APPROPRIATE  FOR  THIS  CASE.) 

71  FORMAT (  /7Xf 59HTABLE  OF  CONCENTRATION  VS  TIME  AT  SPECIFIED  POINT 
1  -  MODEL  P) 

7 2  FORMA T ( //I 4X » 12HELAPSED  TIHE,6X,13HC0NCENTRATI0N,5X,13HC0NCENTRATI 
ION) 

73  FORMAT (17X*6H(MINS),13X.5H (PPM) >1 IX, 10H(MG/LITER)/) 

75  FORMAT (12X»G13.5f5X.G13.5»5X.G13.5) 

76  FORMAT ( /5X.35HTHE  COORDINATES  FOR  THIS  TABLE  ARE-) 

END 

0VERLAYU0.3) 

PROGRAM  MODR 

SUBROUTINE  MODR  OBTAINS  THE  NECESSARY  DATA  FOR  THE  EXECUTION 
OF  SUBROUTINE. EVAMX.  HHICH  CALCULATES  THE  TOTAL  MASS  OF 
VAPOR  PRODUCED  WHEN  A  WATER-MISCIBLE  HIGH  VAPOR  PRESSURE 
LIQUID  IS  SPILLED  ON  HATER  AND  MIXES  WITH  HATER  DUE  TO 
TURBULENT  DIFFUSION 
DATA  M0D/4H  R  / 

OBTAIN  NECESSARY  DATA 

2  CONTINUE 

CALL  TRACE(0.8.3) 

CALL  BEGPR(MOD) 

LP=6 
IR-0 
I ~  6 

CALL  IRCL(2028. IFLAG* IS. IR) 

IF( IFLAG-2)  10,10.20 
20  IFLAG=2 

CALL  PAGER (3) 

HRITE(LP.IOO) 

10  CONTINUE 

CALL  FRCL( 1002.XM0L. IS, IR) 

AM=XMOL 

IF ( IFLAG.EQ.  1 )  CALL  FRCLU003,TF0IL,IS,IR> 

Estt  naiimsHtiRiR' 

CALL  FRCLClOll.BCR.IS.IR) 

CALL  FRCL< 1012.CCR, IS. IR) 

CALL  FRCL ( 1021 » DLB. IS, IR) 

IF ( IFLAG.EQ. 1 )  CALL  FRCL( 1025.TCRIT.IS.IR) 

CALL  FRCL(2023,TW, IS, IR) 

CALL  FRCL(2054»TA, IS, IR) 

IF(IFLA6.NE.2)  GO  TO  1 
CALL  FRCL (2044 ,D, IS, IR) 

CALL  FRCL(2045,W, IS, IR) 

CALL  FRCL (2047, US, I S, IR) 

CALL  FRCL ( 2052, XN, IS, IR) 

1  CALL  VAPPR ( ACR , BCR , CCR , TH , PVAP ) 


,  XMOL, IS, IR) 

CALL  FRCLU003,TB0IL,IS,IR> 

,  BCR , IS, IR) 

,CCR, IS, IR) 

, DLB, IS, IR ) 

CALL  FRCL(1025,TCRIT,IS,IR) 
»TW,IS,IR) 

,  TA, IS, IR) 


GO  TO  1 
,D, IS, IR) 


, W, IS, IR) 

,US, IS, IR) 

,XN, IS, IR) 

, BCR, CCR, TH, PVAP) 


CALCULATE  MOLE  FRACTIONS  OF  CHEMICAL  IN  HATER  BELOW  WHICH 
FLAMMABLE  AND  TOXIC  VAPORS  CANNOT  BE  GENERATED, 

CALL  FRCL ( 2032, CTQX, IS, IR) 

CALL  FRCL ( 2033, CFIR, IS, IR) 

SHSWHtt*"- 

CSTMT=CTOX/PVAP 

CSTMFaCFIR/PVAP 

CALCULATE  DIFFUSION  COEFFICIENT  OF  VAPOR  WITH  AIR 


CALL  PAGER (3) 
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URITE(IP*200> 

CALL  CQMPD< AM*TA*DLB*DIFVA) 

CALI  FSV<2053*DIFVA»4> 

CALL  FRCL (2053*  DIFVA* IS* IR) 

CALL  FRCL (4002*  ZML* IS* IR) 

CALCULATE  DIFFUSION  COEFFICIENT  OF  LIQUID  CHEMICAL  IN  WATER 

IF(IFLAG.EQ.2>  GO  TO  60 
CALL  PAG£R<3) 

WRITE(LP*  70) 

CALL  CDIFW<AM*DLB»TU*TCRIT*TPOIL*BIFLU> 

DIFLW=1000.*DIFLW 
CALL  FSV(2043*DIFLW*4> 

CALL  FRCL<2043*DIFLW*IS*IR) 

60  CALL  EPRNT (MOD* IS* IR* IL ) 

IF(IL.EQ.t)  GO  TO  99 
IF(IL  »EQ*2)  GO  TO  2 

CALL  EVAHX  -  THEN  UPDATE  DATA  BASE 

CALL  OUTPR(MOD) 

CSTM=CSTMT 
SMAX=0 . 0 

DOL^6°I=l»2 

IF(CSTMT.EQ.O.O)  IFLG=1 
IF (CSTM.EQ.O.O)  GO  TO  35 

CALL  EVAMX ( ZML *XMQL*ACR*BCR»CCR* DIFVA *DENL* DIFLU *IFLAG*D>U>US*XN 
♦*TU*CSTM*ZMV*S*SIZNX*THAT> 

IF ( IFLG<EQ<0<AND< I .EQ.2)  GO  TO  31 
CALL  PAGER(2) 

IF(IFLG.EQ.O)  HRITE(LP*50) 

IF(IFLG.EO.l)  WRITE(LP*40) 

CALL  FSV ( 4023*  ZMV . 4 ) 

CALL  FSV(  4024* S?4 ) 

Cr.L  FSV<2019*SIZMX»4) 

CALL  FRCL (2019*SIZMX*IS*IR> 

SNAX=SI ZMX 
FLOW*ZMV/THAT 
CALL  FSV(4044*FL0U*4) 

CALL  FSV(4045*THAT ,4) 
ttm*THAT 
GO  TO  3*5 
31  CALL  PAGER(2) 

WRlTE(LP»40) 

CALL  FSV(4056*ZMV*4> 

CALL  FSV(4057,S*4) 

CALL  FSV( 4058* SIZMX* 4 ) 

FLOU=ZMV/THAT 

CALL  FSV(405?*FL0W*4) 

CALL  FSV(4060*THAT*4) 

GO  TO  30 
35  CSTM=CSTMF 
30  CONTINUE 

IF(SMAX.EQ.O.O)  SMAX=SIZMX 
CALL  PAGER(2) 

WRITE(LP*39) 

SNAX*0 . 638ISMAX 
CALL  FSV(2019*SMAX*6) 

CALL  PAGER(l) 

WRITE(LP*38) 

IF ( TTM.LT .600* )  CALL  ISV(2061* 0*4) 

IF(TTM.GE.AOO.)  CALL  ISV(2061 *1 *4) 

m  Wii8il:h») 

IF(TTM.GE.&00.)  GO  TO  98 
CALL  FRCL ( 4023 * ZMV* IS* IR) 

98  m 

GO  TO  99 

38  FORMAT (52H  THE  VAPOR  SOURCE  PARAMETERS  ARE  ESTIMATED  AS  BEING-) 
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39  FORMAT </lX»49HSIZE  IS  SET  TO  MEAN  SIZE  IN  CASE  MODEL  S  FOLLOWS.) 

40  FORMAT ( 1X*44HF0R  THE  LOWER  FLAMMABLE  LIMIT  CONCENTRATION./) 

50  FORMAT ( 1X*28HF0R  THE  TOXIC  CONCENTRATION./) 

70  F0RMAT(/64H  THE  DIFFUSION  COEFFICIENT  OF  CHEMICAL  WITH  WATER  IS  CA 
1LCULATED./) 

100  F0RMAT(66H  WARNING-  MODEL  R  DOES  NOT  TAKE  INTO  ACCOUNT  TIDAL  EFFEC 
*TS.  IT  IS  /42H  ASSUMED  THAT  SPILL  IS  IN  NON-TIDAL  RIVER./) 

200  FORMAT !/59H  THE  DIFFUSION  COEFFICIENT  OF  VAPOR  WITH  AIR  IS  CALCULA 
*TED./) 

99  CALL  TRACE(l*8t3) 

END 

SUBROUTINE  EVAMX(ZML*XMOL*  ACR*BCR*CCR*DIFVA*DENL*DIvl*-'"  IFLAG* D*W* 
XUS*XN*TW*CSTM*ZMV*S*SIZMX*THAT) 

cxxxxxxxxxxxxxxxxxxxxxxxxxxxxx**xxxxxxxxxxxxxxxxxxxxxxxxxxtxxxxxxxxx*xx* 

c 

XXX  THIS  SUBROUTINE  CALCULATES  THE  TOTAL  MASS  OF  VAPOR  PRODUCED  WHEN 
WATER  MISCIBLE-  HIGH  VAPOR  PRESSURE  LIQUID  IS  SPILLED  ON  WATER  A 
MIXES  WITH  THE  WATER  DUE  TO  TURBULENT  DIFFUSION. 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 


************ 


*** 

*** 

*** 

*** 

*** 

XXX 

*** 

X** 

XXX 

XXX 

*xx 

XXX 

XXX 

*xx 

XXX 

*xx 


ZML 
XMOL 
ACR 
BCR 

D?FVA 

DENL 

DIFLW 

IFLAG 

D 

U 

US 

XN 

TW 

CSTM 


INPUT  ARGUMENTS  XXXXXXXXXXXX 
MASS  OF  LIQUID  SPILLED 
MOLECULAR  WEIGHT  OF  THE  LIQUID  SPILLED 
CONSTANTS  IN  THE  VAPOR  PRESSURE  EQUATION 


GMS 

P=10XX( ACR-BC 


DIFFUSION  COEFFICIENT  OF  VAPOR  IN  AIR  AT  AMBIENT  TEMP 
DENSITY  OF  LIQUID  AT  THE  SPILL  TEMPERATURE  GM/C 

DIFFUSION  COEFFICIENT  OF  LIQUID  IN  WATER  CMX 

A  FLAG  INDICATING  THE  LOCATION  OF  SPILL  (1=STILL  WATER* 
2=FL0WING*  NON  TIDAL  RIVER 
RIVER  DEPTH  (TO  BE  GIVEN  ONLY  IF  IFLAG=2) 

RIVER  WIDTH  - "  - 

AVERAGE  VELOCITY  OF  THE  STREAM  - 

STREAM  ROUGHNESS  FACTOR  —  **  . 

WATER  TEMPERATURE 


CMS 

CMS 

CM/ 


_  _  DEG 

=  LIMITING  VALUE  OF  THE  MOLE  FRACTION  CONCENTRATION,  THAT 
CONTRIBUTION  TO  EVAPORATION  FROM  WATER  SURFACE  REGIONS 
THIS  CONCENTRATION  IS  NEGLIGIBLE. 


XXXXXXXXXXXX 
XXX  ZMV 
XX*  S 


XXX 

XXX 


OUTPUT  ARGUMENTS  XXXXXXXXXXX 

maximum  dis?ancebinath£  STREAM  DIRECTION  BEYOND  WHICH 
CONCENTRATION  IS  EVERYWHERE  LESS  THAN  ‘CSTM’. 

SIZMX  =  MAXIMUM  SIZE  (RADIUS)  OF  THE  SPREAD  CMS 

THAT  *  TIME  AT  WHJCH  CONCENTRATION  EVERYWHERE 


CMS 


LESS  THAN  CSTM 


SECS 


cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

c 

COMMON/C/PLTYP*XBX( 150) 

INTEGER  PLTYP 
DIMENSION  FX( 101 ) » ZM (101 ) 

EQUIVALENCE  <XBX< 1 ) *FX( 1 > ) 

PI=3. 141592654 

TP=0 1 

T=0, 

UT=0 . 

VOLI=ZML/BENL 

CALL  HMTC ( DIFVA  *  XMOL » VOL  I  *  HMP ) 

GO  TO  ( 10*20) * IFLAG 
10  EX=DIFLW 
EY*DIFLW 
EZ=DIFLW 
GO  TO  30 

20  CALL  DISP(W»D*IFLAG*T*US*UT*XN*TP*E*EX*EY*EZ) 

30  CALL  VAPPR(ACRfBCR*CCR*TW*PVAP) 

CSTAR“(CSTM/( 1 .-CSTM) )t (XMOL/ 18. ) 

C 

jj  XXX  CALCULATION  OF  THE  CHARACTERISTIC  CONSTANTS  XXXXXXX 

THAT* ( 1 . /( 4 .XPI ) )X( 2 .XZML/( CSTARXSQRT (EXXEYXEZ ) ) )XX(2 ,/3. ) 
A*SQRT(4.XEXXTHAT) 
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B=SQRT(4.*EY*THAT> 

BZMCH=PI*A*B*HMP*PVAP 
ZMCHR  =DZMCH  *THAT 

(t  INTEGRATION  PREPARATION  ******** 

N=101 
FX( 1 )=0» 

?8h*Ma?  ( ?-l )  /FLOAT  (N-l ) 

CMAX=CSTAR/TOH**l »5 

►  'TON*  IS  THE  NON  DIMENSIONAL  TIME  =  TOME/THAT,  CMAX  IS  THE  MAXIM 
CONCENTRATION  AT  ANY  TIME  IN  GM/CM**3 

CMAXM=CHAX/(CMAX+XMOL/18. > 

IF (TOW-0.98)  50»50»60 

CMENM= ( CMAXM-CSTM ) /ALOG ( CMAXM/CSTM ) 

GO  TO  40 
CMENM=CSTM 

FX ( I ) =-l ,5*T0U*CMENM*AL0G ( TON ) 

FX(N)*0 . 

DT0W=1 • /FLOAT < N-l ) 

I  SIMPSON'S  RULE  INTEGRATION  *********** 

CALL  QSF(DTOW»FX»ZM»N) 

ZMV=ZMCHR*ZM<N) 


IF (SIZMX.GT .SQRT(EY*THAT) )  SIZMX=SQRT<EY*THAT) 

RETURN 

END 

SUBROUTINE  QSF(H»Yf ZtNDIM) 

C  ***  SIMPSON=S  RULE  INTEGRATION  ROUTINE  .  FOR  DETAILS  SEE  THE  IBM  MA 
C 

DIMENSION  Y(l).Za) 

HT=.3333333*H 

Ll  =  l 

L2=2 

L3=3 

L4=4 

L5=5 

LA=6 

IF(NDIM-5)7>8> 1 

C  NDIM  IS  GREATER  THAN  5.  PREPARATIONS  OF  INTEGRATION  LOOP 

1  SUM1*Y(L2)+Y(L2) 

SUM1=SUM1+SUM1 
SUM1=HT*<  Y(L1 )  +  SUMl  +  Y<L3>  > 

AUX1=Y(L4)4Y<L4) 

AUXI=AUX1+AUX1 

AUXl=SUMl+HTl!(Y(L3>+AUXl+Y(L5) ) 

AUX2*HT*(Y(L1)F3,875*(Y(L2)+Y(L5))+2.625*(Y(L3)+Y(L4))+Y(L6)) 

SUK2=Y(L5W<L5) 

SUM2=SUM2+SUM2 

SUM2=AUX2-HTt(Y(L4)+SUM2+Y(L6>) 

7(L1)=0, 

AUX=Y(L3W(L3> 

AUX=AUX+AUX 

Z<L2)«SUM2-HT*(Y(L2)+AUX+Y(L4>) 

Z(L3)*SUM1 
Z(L4)»SUM2 
IF(NDIM-A>3*5>2 
C  INTEGRATION  LOOP 

2  DO  4  I*7»NDIM>2 
SUM1=AUX1 
SUM2=AUX2 

AUXt*SUMl+HT*( Y( I-2)tAUXl+Y<I > ) 

Z<I-2)*SUM1 
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IF ( I-NDIM)3»6»6 

3  AUX2=Y <I)+Y(I> 

AUX2=AUX2+AUX2 

AUX2=SUM24-HT*(Y{I-1)+AUX2+Y(IH)> 

4  Z ( I  —  1 >  =SUM2 

5  Z(NDIM-1)=AUX1 
Z<NDIM)=AUX2 
RETURN 

4  5iB8!tlTU5?f2 

RETURN 

C  END  OF  INTEGRATION  LOOP 
7  IF<NDIM-3)12, 11.8 
C  NDIH  IS  EQUAL  TO  4  OR  5 

9  SUH2=1,125*HT*(Y(L1)+Y(L2)+Y(L2)+Y(L2)+Y(L3)+Y(L3)+Y(L3)+Y(L4)) 
SUhl=Y(L2)+Y(L2) 

SUM1=SUM1+SUM1 

SUM1=HT*(Y(L1)+SUM1+Y(L3)> 

Z(L1>=0. 

AUX1=Y(L3)+Y(L3) 

AUX1=AUX1FAUX1 

Z<L2)=SUM2-HT*<Y<L2)+AUX1+Y(L4)> 

IF ( NDIM-5 ) 10 » 9, 9 
9  AUX1=Y(L4)+Y(L4) 

AUX1=AUX1 +AUX1 

Z(L5)=SUN1+HT*(Y(L3)+AUX1+Y<L5) ) 

10  Z(L3)=SUM1 
Z(L4)=SUM2 
RETURN 

C  NDIH  IS  EQUAL  TO  3 

11  SUH1=HT*(1,25*Y(L1)+Y(L2)+Y(L2)-.25*Y(L3)) 

SUM2=Y(L2)+Y<L2) 

SUM2=SUM2+SUM2 

Z(L3)=HT*(Y<L1)+SUM2+Y(L3>> 

Z(L1)=0. 

Z(L2''=SUH1 

12  RETURN 
END 

SUBROUTINE  VAPPR<A»B,C,T,PVAP> 

c*********************************************************************** 

THIS  SUBROUTINE  CALCULATES  THE  VAOPR  PRESSURE  OF  ANY  COMPOUND  AT  T 
GIVEN  TEMPERATURE.  THE  EQUATION  USED  IS  SIMILAR  TO  THE  CLAUSIUS  CL 
EQUATION. NAMELY  P  =  10**<A-B/(T+C) ) . 


************ 
***  A 
***  B  = 

m  c 

***  T 
************ 


INPUT  ARGUMENTS  ************ 

CONSTANT  IN  THE  VAPOR  EQUATION 
CONSTANT  IN  THE  VAPOR  EOUATION 
CONSTANT  IN  THE  VAPOR  EQUATION 

TEMPERATURE  AT  WHICH  THE  VAPOR  PRESSURE  IS  TO  BE  KNOWN 
OUTPUT  ARGUMENTS  *********** 


***  FVAP  *  VAPOR  PRESSURE  AT  THE  TEMPERATURE  =T=  .  ATM 

*********************************************************************** 

PUAF'=(  10.**(  A-(B/(T+C) ) )  )/760. 

RETURN 

END 

OVERLAY <10,4) 

PROGRAM  MODT 

SUBROUTINE  MODT  UTILIZES  ROUTINES  RLJSP,TSPRD,  AND  FTCON  TO 
CALCULATE  THE  CONDITIONS  AFTER  THE  SPILL  OF  AN  INSOLUBLE  OR 

IbIB¥5fcTpB?b¥BfelE£¥iSI9SkHu¥igHAiliti?HTiS^KS¥r.SiTE!ElN¥H8li 

ROUTINES  FOR  SPECIFIC  CAPABILITIES. 


DIMENSION  PTITL(6),XTITL<6),XTITL1(A),YTITL(6)» 
1  PTITLK6) ,  YTITLKA) 
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DIMENSION  AT (20) » AS (20) fASAVT (20) fASAVS(20) fASAV(20f2) 

EQUIVALENCE  (XBX(64) t IDIHX) » (XBX(81 ) fAT<1 ) ) t <XBX( 101) »AS(1) ) 
EQUIVALENCE  <XBX(21 ) . ASAVT( 1) ) f (XBX( 121 ) » ASAVS( 1 ) ) 

DATA  M0D/4H  T  / 

ODATA  (PTITL  ( I) >1=1 f6)/8HP00L  RADf8HIUS/LENGf8HTH  VS  TIf 
18HME  -  hODf 8HEL  T  »1H  / 

ODATA  (PTITL1(I)fI=1f6) /BHCONCENTR  f  8HATI0N  VSf8H  TIME  ATf 
18H  A  FIXEDf 8H  POINT  -f8H  MODEL  T/ 

ODATA  (XTITL  ( I ) i 1=1 f 6)/8HELAPSED  .8HTIME  FR0»8HM  START  » 

18H0F  SPILL18H . ( »8HMINUTES)/ 

ODATA  (XTITL1(I)fI=1 >6) /8HELAPSED  »8HTIME  FR0»8HM  START  , 

18H0F  SPILLf8H . f8H. (HOURS)/ 

ODATA  ( YTITL  ( I ) t 1=1 f6> /8HP00L  RADf8HIUS  f8H0R  LENBTf 
1.8HH  f8H(METERS)  f  1 H  / 

ODATA  <YTITL1(I)fI=1f6)/8H  C0NCEf8HNTRATI0Nf8H  AT  Pf 
18H0INT  XYZfIH  fIH  / 

12  CONTINUE 

CALL  TRACE(0f8f4) 

LP=6 

IR=0 

IS=6 

INDC=2 

Pl=3. 14159265 

OBTAIN  DATA 

CALL  BEGPR(MOD) 

CALL  IRCL ( 2086 f MDTYP fISfIR) 

IF(MDTYP.EQ.l)  GO  TO  5 

WHEN  MBTYP  IS  Of  THE  MODEL  FOR  PODL  SIZE  VS  TIME  IS  EXECUTED. 

WHEN  MDTYP  IS  If  THE  MODEL  FOR  CONCENTRATION  AT  XYZT  IS  EXECUTED. 
WHEN  MDTYF  IS  2.  BOTH  THE  ABOVE  MODELS  ARE  EXECUTED. 

CALL  IRCL ( 2058 f INDC f ISf IR) 

IF(INDC.GE.l)  IDIM=2 
CALL  FRCL(1004fDENLfISfIR) 


THE  DENSITY  IS  CHECKED  TO  ENSURE  IT  IS  LESS  THAN  THAT  OF  WATER 
IF(DENL.LT,l.)  GO  TO  2 
CALL  PAGER<5) 

URITE(LPf3) 


DENL=0.99 
2  CONTINUE 


IF ( INDC.EQ.O)  CALL  FRCL(1006f 
IF(INDC.EQ.O)  CALL  FRCL(1031f 
IF(INDC.GE.l)  CALL  FRCL(2008f 

Ettb  FSEbii*5«: 

IF ( INDC.GE . 1 )  CALL  FRCL(4050f 
CALL  FRCL ( 2056 fTIMEf ISf IR) 

IF  (INDC.GE. 1)  CALL  FRCH2059 
CALL  FRCL ( 4002 fSPAMTf IS fIR) 
VOL*SPAMT/DENL 
IF (MDTYP. EQ.O)  GO  TO  6 
CALL  FRCL(1002fAMfISfIR) 

CALL  FRCL(1003fTB0ILfISfIR) 

IF (MDTYP. EQ.l)  CALL  FRCL(1004 


VISLfISfIR) 

SURTfISfIR) 

diafISfIr: 

CHNLW  f IS  f IR ) 

FLOBfISfIR) 

ENDTMfISfIR) 

fHGT  fISfIR) 


fDENLfISfIR) 


C 


THE  DENSITY  IS  CHECKED  TO  ENSURE  IT  IS  LESS  THAN  THAT  OF  WATER 
IF(MDTYP.NE. 1 .OR, DENL .LT . 1 . )  GO  TO  4 
CALL  PAGER(5> 

WRITE(LPf3> 


IF(MDTYP, EQ.l. OR. INDC. EQ.l)  CALL  FRCL(IOOAfVISLfISfIR) 

att  n&MSn:HD:il:ni 

CALL  FRCL( 1025fTCRIT  fISfIR) 

IF(MDTYP. EQ.l. OR. INDC, EQ.l)  CALL  FRCL(2020fCHNLWf ISfIR) 
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HH=CHNLH 

CALL  FRCL( 2023 .THAT  > IS  * 1R  > 

CALL  FRCL(2039»X  .IS.IR) 

CALL  FRCL<2040» Y  .IS.IR) 

CALL  FRCL<2041»Z  .IS.IR) 

CALL  FRCL<2042*T  .IS.IR) 

CALL  PAGER (3) 
yRITE<LP.7) 

CALL  CBIFHtAH.DENLB.THAT.TCRIT.TBOIL.DIFCO) 

CAtL  FSV(2043»DIFC0»4) 

CALL  FRCL ( 2043 .DIFCO. IS.IR) 

CALL  FRCL<2044,DH. IS.IR) 

CALL  FRCL (2047. US. IS.IR) 

CALL  FRCL ( 2052 >XN» IS » IR) 

IF (MDTYP.EQ. 1 .OR. INDC .EQ« 1 )  CALL  FRCU4002.SPAMT, IS» IR) 

CALL  ROUTINE  SOLUB  TO  FIND  SOLUBILITY  OF  CHEMICAL  IN  HATER 
SOLUB  CALLS  DATA  OF  FIELD  NUHBERS  1026.  1028.  AND  1029. 
CALL  SOLUBdHAT.CSAT. IS.IR) 

CSAT=CSAT/100. 0 

6  CONTINUE 

CALL  IRCL(3009,ITPF. IS.IR) 


IF  ITPF  IS  0. 
IF  ITPF  IS  1. 
IF  ITPF  IS  2. 

IF  ITPF  IS  3, 


NO  PLOTS  ARE  PRODUCED. 

A  PLOT  OF  POOL  SIZE  VS  TIHE  IS  GIVEN. 

A  PLOT  OF  CONCENTRATION  AT  A  USER  SPECIFIED  POINT 
VS  TIHE  IS  GENERATED. 

BOTH  PLOTS  DESCRIBED  ABOVE  ARE  GENERATED. 


CALL  IRCL(3017,ITAB. IS.IR) 


IF  ITAB  IS  0. 
IF  ITAB  IS  1. 
IF  ITAB  IS  2. 


NO  TABLES  ARE  PRODUCED. 

GIVES  TABLE  OF  POOL  SIZE  VS  TIHE. 

GIVES  TABLE  OF  PEAK  CONC  AT  MIDDLE  AND  BOTTOH  OF 


19 


20 


IF^ITAB^IS*3^  GIVES^ABLE^OF  CONC  VS  TIME  AT  SPECIFIED  XYZ. 

If  H8!  II J;  HUB  ^toWS^e!escribed‘ 

IF(ITPF.NE.O.OR.ITAB.NE.O)  CALL  FRCL(2055.TMXT. IS. IR) 

CALL  EPRNT(MOD.IS.IR.IL) 

IF(IL.EO.l)  GO  TO  99 
IFdL.EQ.2)  GO  TO  12 
IF(MDTYP.EQ.l)  GO  TO  50 
IF(INDC.LE.O)  GO  TO  20 

CALL  TSPRD  FOR  CONTINUOUS  RELEASES 

SizMX— 1 

CALL  TSPRD(DENL.DIA.HGT»FLOH. TIME. SIZE) 

IF(TIME.LT.ENDTM)  GO  TO  19 
VL=FLOU*ENDTM 
AIREA=VL/0.01 
SIZMX=SGRT( AIREA/PI ) 

IF(SIZE.GT. SIZMX)  SIZE=SIZMX 

DIAM=2.*SIZE 

CALL  OUTPR(MOD) 

CALL  FSV<4025»SIZE»4) 

CALL  FSV(4007»DIAM. 4) 

IF(SIZE.EQ. SIZMX)  CALL  PAGER(6) 

IF(SIZE.EQ. SIZMX)  HRITE(LP.IB) 

GO  TO  50 
IDIM=2 

CALL  RLJSP  FOR  INSTANTANEOUS  RELEASES 

CALL  RLJSPdDIM. VOL. DENL.VISL.SURT. TIME. CHNLU. SIZE) 
AREA-SIZEtSIZEtPI 

01)  SIZE*SQRT(V0L/(0.01tPI) > 

DIAH*2.*SIZE 

IFtDIAM.LE. CHNLU)  GO  TO  15 
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IP!H=1 

TALL  RL JSP ( IDIM» VQL»DENL» VISLiSURT » TIME »CHNLU» SIZE ) 

AREA=CHNLU<SIZE 

THICK=VOL/AREA 

IF (THICK.LT. 0.01)  SIZE=VOL/(0,01*CHNLW> 

15  CALL  OUTPR(MOD) 

CALL  PAGER(l) 

IF(IDIM.EQ.2)  WRITE(LP»31) 

DIAM=2.*SIZE 

IFCIDIM.EQ.l)  DIAM=SQRT(SIZE*CHNLW*4./3. 14159) 

CALL  FSV(4007,DIAM,4) 

CALL  PAGER(4) 

WRITE(LP.U) 

50  IF (MDTYP .EQ .0)  GO  TO  30 

CALL  FTCON  TO  FIND  CONCENTRATION  AT  USER  SPECIFIED  POINT 

CALL  FTCON (DM, UU.US»DIFCO»CSAT»SPAHT,DENL»VlSL>SURFC»XN»TtX>Y»Z» 

1  DISRT .DISTMfPLCNXfCONC) 

IF(CONC.GT.DENL)  C0NC=DENL 
IF(HDTYP.EQ.l)  CALL  OUTPR(NOD) 

CALL  FSV(4061»DISRTr4) 

CALL  FSV(4062'DISTM»4 ) 

CALL  FSV(4063.PLCNX>4) 

CALL  FSV(4064?C0NC»4) 

C0NC=C0NC*1000000.0 
CPPM=CGNC/DENL 
CALL  PAGER(2) 

WRITE (LP» 51)  CPPM.CONC 
20  CALL  ENDPR(MOD) 

INTERROGATE  USER  PLOT  AND  TABLE  REQUEST  FLAGS 

IF( ITPF.EQ.O. AND. ITAB.EQ.O)  GO  TO  99 
IF( ITPF.EQ. 1 . OR . ITPF .EQ.3)  GO  TO  8 
IF ( ITAB .EG. 1 .OR, ITAB.EQ.5)  GO  TO  8 
GO  TO  1 

9  DT=TMXT/20 .0 

IF(MDTYP.EG.l)  GO  TO  1 

SET  UP  LOOP  FOR  CALCULATION  OF  PLOT  ARRAYS  OF  SIZE  OF  LIQUID 
POOL  VERSUS  ELAPSED  TIME 

ISVI=0 

IDM=2 

DO  10  I=1f20 

AT(I)=(FL0AT(I-1)*DT)+DT 

IF(INDC.LE.O)  GO  TO  11 

CALL  TSPRD(DENL»DIAfHGT f FLOW f AT < I ) » AS < I > ) 

IF( AT ( I ) .GT .ENDTM . AND . AS( I ) ,GT . SIZMX)  AS(I)=SIZMX 
11  CONTINUE 

IF(INDC.LE.O)  CALL  Rl JSP< IBN> VOL*DENL» VISL»SURT»AT ( I > tCHNLWf AS( I ) > 
IF(INDC.EQ.l)  GO  TO  9 
IF ( IDM.EQ.2)  AREA“AS ( I ) *AS ( I ) *PI 
IF ( IDM.EQ , 1 )  AREfr=CHNLU*AS(I) 

THICK=VOL/AREA 

IF<THICK.LT,0,01 . AND, I DM. E 0.2)  AS( I)=SQRT(V0L/(0.01*PI ) ) 

IF (THICK. LT, 0.01. AND. IDM.EQ. 1)  AS( I )=V0L/(0.01*CHNLW> 

9  CONTINUE 

IF( ISVI ,GT . O.OR. INDC.EQ. 1 )  GO  TO  10 
DIAMT=2,*AS(I) 

IF ( DIAMT .GT.CHNLH)  IDM-^1 
IF< DIAMT.GT, CHNLU)  ISVI=I 
10  CONTINUE 

IF( ITAB.NE. 1 .AND.ITAB.NE.5)  GO  TO  26 

WRITE  TABLE  OF  POOL  SIZE  VS  TIME 

CALL  PAGER <0) 

CALL  PAGER54) 


nnnn  oono  ooooo 


WRITE<LP»21 ) 

CALL  PAGER(l) 

WRITE(LP»22) 

CALL  PAGER(l) 

URITE<LP.23> 

DO  40  I=l» 20 
ATM=AT ( I  )/60. 

ASM=AS( I )/100. 

ASFT=AS(I)/<2. 54*12.) 

CALL  PAGERU' 

WRITE(LP»24)  f:T ( I ) » ATM .AS ( I  >  .ASM. ASFT 
40  CONTINUE 

STM=(FLOAT(ISVI)-1.)*DT/60.0 

IF< ISVI . GT .0. AND • INDC.EQ . 0)  CALL  PAGER<3) 

IF ( ISVI .GT .0. AND . INDC .EQ.0)  WRITE ( LP » 27 )  STM 
CALL  PAGER(4) 

WRITE(LP. 16) 

26  IF ( ITPF.E0.0.0R. ITPF.E0.2)  GO  TO  1 
WRITE  PLOT  OF  POOL  SI7E  VS  TIME 


. SET  UP  FOR  FIRST  OFF-LINE  PLOT 

PLTYP=8 

IDIMX=IDIM 

II=C 

JJ=40 

DO  700  IX=1.20 

55:55.1 

XBX ( II )=AT ( IX ) 

700  XBX( JJ)=AS(IX) 

DO  41  1=1.20 
ASAVT ( I )=AT  < I ) /AO . 

41  ASAVS( I )=AS< I )/100. 

CALL  PLTLP(PTITL» ASAVT .ASAVS.20.XTITL.YTITL. 1 .60. rXTITLl ) 

CALL  PAGER(3> 

IFdSVI.GT.O. AND. INDC. EQ.O)  URITECLP.27)  STM 
1  CONTINUE 


IHHtWMirh  W<4> 00  T0 ,0 


COMPUTE  DATA  FOR  A  TABLE  OF  PEAK  CONCENTRATIONS  AT  MID-DFPTH  AND 
BOTTOM  DEPTHS  OF  RIVER  VS  TIME  AND  DISTANCE. 

ZZ=DW/2, 

YY=0.0 

DT=TMXT/20. 

DO  60  1 1  =  1 »2 
DO  70  1=1.20 
AT ( I )=DT+(FLOAT ( 1-1 )*DT) 

AS( I )=US*AT(I ) 

CALL  FTCON(DW»WWiUS»DIFCO. CSAT. SPAMTt DENL. VISL.SURFC.XN. AT ( I ) . AS( I 
1  ) i YY.ZZ.DISRT.DISTM.PLCNX  »ASAV( I  .II ) ) 

I F ( ASAV (I . I I ) . GT . DENL )  AS AV ( I . I I )*DENL 
ASAV(I>II)=ASAV(IfII)*1000000.0/DENL 
70  CONTINUE 
ZZ=DW 

60  CONTINUE 

WRITE  TABLE  OF  PEAK  CONCENTRATIONS  AT  MID-DEPTH  AND  BOTTOM  DEPTHS 
OF  RIVER  VS  TIME  AND  DISTANCE. 

Eftt  MRM 

WRITEU.P.52) 

CALL  PAGER (1 ) 

WRITEELP.35) 

DO  80  1=1.20 
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XHET=AS(I)/100. 

XFT=XMETt3.281 
TMNS=AT  < I )/60. 

THRS=TMNS/60. 

CALL  PAGER < 1 ) 

WRITE ( LP » 54 )  XHET *XFT  * TMNS *  THRS  * ASAV ( I » 1 ) * AS A V (1.2) 
80  CONTINUE 
CALL  PAGERC5) 

IHlffittMSio)  GO  TO  99 
90  IFdTAB.LT. 3. AND.ITPF.LT. 2)  GO  TO  99 


COMPUTE  DATA  FOR  A  TABLE  OR  PLOT  OF  CONCENTRATION  VS  TIME  AT  A 
USER  SPECIFIED  POINT  XYZ 


TAsY/IIQ 

ifcts;le.o.o>  TS=1. 

TS1=TS 

91  CALL  FTC0NCDW*WW*US*DIFC0*C5AT*SPAMT*DENL*VISL*SURFC*XN*TS»X*Y*Z* 

1  DISRT  rDISTMf PLCNXrCONC) 

C0NC=C0NC* 1000000 , 0/DENL 
IFCCONC.GT , 10. )  TS=TS-CTSl/50. ) 

IFCCONC.GT. 10.0. AND. TS.LT. 0.0)  TS=0.01 
IFCCONC. GT. 10.0. AND. TS.EQ. 0.01)  GO  TO  96 

IFCTS.LT. 0.0)  TS=0«01 
96  DT=2.*CTS1-TS)/19. 

IFCDT.LT. 3. 16)  DT=60./19. 

DO  92  1=1 *2C 

ATCI)=TS+CFL0ATCI-1)*DT> 

CALL  FTCONCDW* WW*US* DIFCD*CSAT *SPAMT*DENL*VISL*C.;RFC*XN*  ATCI) » X * Y i 
1  Z*DISRT*DISTM*PLCNX* ASC I ) ) 

92  CONTINUE 


WRITE  A  TABLE  OF  CONCENTRATION  VS  TIME  AT  A  USER  SPECIFIED  POINT. 


IFCITAB.LT.3)  GO  TO  94 
CALL  PAGERCO) 

CALL  PAGERC5) 

HBI'ftWtJ) 

URITECLP.57) 

CALL  PAGERC1) 

WRITE  CLP *58) 

94  DO  93  1=1*20 
AT  C I ) =AT  < I ) / 60 . 

THRS=AT  C I )/60. 

IF(ASCI).GT.DENL)  ASCI)*DENL 
ASC I)=ASC I )*1000000, O/DENL 
CNGL=AS(I)*DENL 
IFCITAB.LT.3)  GO  TO  93 


ATC I ) *  THRS* ASC I >  *CMGL 


93  CONTINUE 

IFCITAB.LT.3)  GO  TO  95 
CALL  PAGERC2) 

WRITECLP* 61 ) 

CALL  FRCL(2039*X*IS*IR) 
CALL  FRCL(2040*Y* IS* IR) 
CALL  FRCLC2041 *Z* IS* IR) 
95  IFCITPF.LT. 2)  GO  TO  99 


WRITE  PLOT  OF  CONCENTRATION  VS  TIME  AT  USER  SPECIFIED  POINT. 
CALL  PLTLPCPTITL1 *AT * AS*20*XTITL*YTITLi*l*60. *XTITL1 ) 


C . SET  UP  FOR  SECOND  OFF-LINE  PLOT 

if?5?ft!!E.O)  PLTYP=9 

IFCITMP.EQ.8)  PLTYP=10 
DO  701  1=1*20 
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701  AT<I)*60.*AT<I) 

GO  TO  99 

30F0RMAT(/5X*58HWARNING  -  THE  DENSITY  OF  THIS  SUBSTANCE  HAS  BEEN  EST 
1 IMATED/5X * 57HAS  BEING  THE  SANE  AS  OR  GREATER  THAN  THAT  OF  HATER*  U 
2NDER/5X.70HTHESE  CONDITIONS*  THE  MODEL  ASSUMES  THAT  ITS  DENSITY  IS 
3  0.99  GM/CMU3./) 

7  F0RMATI/65H  THE  DIFFUSION  COEFFICIENT  OF  THE  CHEMICAL  IN  HATER  IS 
1CALCULATED/) 

16  FORMAT (/6X*54H*#t  THIS  ANALYSIS  ASSUMES  THE  POOL  HILL  STOP  SPREADI 
lNG/lOX* 39HHHEN  ITS  THICKNESS  IS  0,01  CENTIMETERS./) 

IB  FORMAT (/6X>49H*t*  SINCE  THE  FLOH  FROM  THE  TANK  STOPS  BEFORE  THE/10 
1X*49HTIHE  AT  UHICH  THESE  POOL  SIZES  HERE  COMPUTED*  THE/10X*47HM0DE 
2L  ASSUMES  THE  POOL  STOPS  SPREADING  HHEN  ITS/10X*30HTHICKNESS  IS  0. 
301  CENTIMETERS./) 

21  FORMAT (/21X,27HP00L  SIZE  US  TIME  -  MODEL  T//> 

22  FORMAT <  8X*4HTIME*8X*4HTIME*8X*4HSIZE*3X*4HSIZE*BX*4HSIZE) 

23  FORMAT (  7X*6H<SECS) *6X*6H<MINS) *7X*5H<CMS) *8X*3H(M> *8X»4H(FT)//) 

24  FORMAT (  SX*G10.4*2X*G10.4*2X*G10.4*2X*G10.4*2X*G10.4>2X>G10.4) 

25  FORMAT < 1X»46H  THE  SPILL  POOL  IS  CONFINED  BY  CHANNEL  BANKSO  ) 

27  F0RMAT(/17X,34Hm  NOTE  -  AT  APPROXIMATELY  TIME  =*G10.4*13H  MINUTE 
IS*  ***/17X*45Hm  THE  POOL  IS  CONFINED  BY  CHANNEL  BANKS  ***) 

31  fORMAT(lX*2?H  THE  SPILL  POOL  IS  CIRCULAR,  ) 

35  FORMAT < 5X * 3H (M ) *9X*4H< FT) *8X*6H(MINS)*8X*5H<HRS)*8X*5H<PPM)*8X»5H( 

1PPM)//) 

51  FORMAT ( /6X* 35HTHIS  CONCENTRATION  IS  EQUIVALENT  T0*1X*G10.4*1X*7HPP 
1M  AND»IX*G10.4*1X*9HMG/LITER. ) 

52  FORMAT ( //16X.48HTABLE  OF  PEAK  CONCENTRATION  US  TIME  AND  DISTANCE/ 
11?X*41HAT  MIDDEPTH  AND  BOTTOM  OF  RIUER  -  MODEL  T//) 

53  FORMAT ( IX* 10HX -DISTANCE  *3X* 10HX-DISTANCE*6X*4HTIME*9X»4HTIME*7X* 
18HMID  C0NC.5X *8HBQT  CONC) 

54  F0RMAT(1X*6(G10.4*3X)> 

55  'ORMAT ( //1X.55HN0TE  -  A  CONCENTRATION  IN  PPM  MULTIPLIED  BY  THE  DEN 
1SITY/1X,53H0F  THE  SPILLED  CHEMICAL  IN  UNITS  OF  G/CMM3  GIVES  THE/ 
21X.26HC0NCENTRATI0N  IN  MG/LITER.) 

56  FORMAT ( //1X,64HTABLE  OF  CONCENTRATION  VS  TIME  AT  USER  SPECIFIED  PO 
1INT  -  MODEL  T//) 

57  FORMAT < 4X* 4HTIME* 1 IX * 4HTIME* 1 IX * 4HC0NC, 11X* 4HC0NC) 

58  FORMAT (3X*6H< MINS) * 10X*5H(HRS) * 10X*5H(PPM) *7X* 1 OH (MG/LITER)//) 

59  FORMAT (1X»4(G10.4*5X>) 

61  FORMAT (/5X.35HTHE  COORDINATES  FOR  THIS  TABLE  ARE-) 

99  gj^L  TRACE < 1*8*4) 

SUBROUTINE  FTCON<DW*HW*US*DIFH*CSAT*SPAMT*DENL*VISL*SURT,XN*T*X*Y* 
1Z*DISRT  *  DISTM*PLCNX,CONC ) 

C 

cmxmmHttutmtmuimmmmmtttmmmmmttttmmt 

c 

C  THIS  SUBROUTINE  CALCULATES  THE  DISSOLUTION  RATE*  TIME  FOR  ALL 

C  SPILL  POOL  HAS  TRAVELED  AT  THE  USER  SPECIFIED  TIME.  THE  ROUTINE 

C  IS  PRIMARILY  WRITTEN  FOR  A  SPILL  POOL  WHOSE  DIAMETER  DOES  NOT 

C  EXCEED  THE  WIDTH  OF  THE  WATERBODY  WHERE  THE  SPILL  OCCURS*  BUT 

C  IS  APPROXIMATELY  CORRECT  FOR  THE  ALTERNATE  CASE.  IT  IS  MEANT  ONLY 

C  TO  BE  USED  UNDER  STEADY-STATE  FLOW  CONDITIONS*  I.E.  A  NON-TIDAL 
C  WATERBODY, 

C 

C  m**INPUTSt»m 

C 

C  DW  DEPTH  OF  RIVER  CMS 

C  WU  WIDTH  OF  RIVER  CMS 

C  US  *  MEAN  STREAM  VELOCITY  CM/SEC 

C  DIFW  =  DIFFUSION  COEFFICIENT  OF  LIQUID  IN  HATER  CM2/SEC 

C  CSAT  =  SOLUBILITY  OF  CHEMICAL  IN  WATER  GM/GM 

e  ir:  H/m 

C  VISL  =  VISCOSITY  OF  CHEMICAL  SPILLED  GM/CM-S 

C  SURT  =  SURFACE  TENSION  OF  CHEMICAL  SPILLED  D/CM 

£  p  :  mra  wimam  emhbtin  kumi 

C  X  DOWNSTREAM  DISTANCE  FROM  SPILL  SITE  AT  WHICH 

C  CONCENTRATION  DESIRED  CM 
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Y  =  DISTANCE  FROM  MIDSTREAM  AT  WHICH  CONCENTRATION 
IS  DESIRED 

2  =  DEPTH  IN  RIVER  AT  WHICH  CONCENTRATION  DESIRED 

mttouTPUTsm** 

DISRT=  DISSOLUTION  RATE  OF  CHEMICAL 

DISTM=  TIME  FOR  ALL  CHEMICAL  TO  DISSOLVE 

PLCNX*  gISTANC|r|p^NgTR^AM  P^OL  CENTER  HAS  TRAVELED  BY 

CONC  =  CONCENTRATION  OF  CHEMICAL  IN  WATER  AT  SPECIFIED 
TIME  AND  LOCATION 


GM/CM2-SEC 

SECS 


GM/CM3 


mmmmmmmmmmmmmmmmmmmmttm  ****** 

DATA  DENWf PI »IDIMfCHNLW»AREA/1.0»3.14159265»2» 10000. ,1.0/ 

CALCULATE  DISSOLUTION  RATE  IN  GM/CM2-SEC 

VOL=SPAMT/PENL 
SCLEN=0,1*DW 
USQBR=0.1*US 

B ARK= 1 .  46*SGRT ( DIFWtUSGBR/SCLEN > 

DISRT=BARK*DENW*CSAT 

FIND  TIME  AT  WHICH  ALL  CHEMICAL  HAS  DISSOLVED 

IST0P=O 
THICK=0 .05 

ARE AC=SPAMT / ( TH1 CKtDENL ) 

BT=300.0 
TIME=DT 

40  CALL  RLJSP(IDIH»VOL»DENLfVISL,SURT»TIME»CHNLW»SIZE> 
AREA=PI*SIZE*SIZE 
IF(AREA.GT.AREAC)  AREA*AREAC 
AREA=0. 707CAREA 

25  IF(ISTOP.EQ.l)  GO  TO  26 
TIME=2,*TIME 
GO  TO  40 

20  IST0P=1 

TIME=TIME-120.0 
IF(TIHE.LE.O.O)  TIME =60. 

IF(TIME.EQ.60.)  GO  TO  26 
GO  TO  40 

26  DISTM=TIME 

CALCULATE  CONCENTRATION  IN  WATER 

RH=WW*DW/ ( 2 . *DW+WW ) 

USTAR=6 . 7305*XN*US/RHU  ( 1 .  /6 . ) 

|Z=0.067|USTAR*RH 

IF(UW/DW-100.)  10»5»5 
5  EY=0.1#EZ 
GO  TO  15 

10  EY=0.23*USTAR*RH 
15  SX=2.*SQRT<EX*T) 

SY=2,tSQRT(EY*T> 

SZ=2.*SQRT(EZ*T) 

XBAR=X-(US*T> 

YBAR=Y 

ZBAR*Z 

CaBMP* 

A  ®  A  t  A 

B=(YBAR/SY)**2. 

Siiimwr1”2' 

D-D*D 

E=(ZBAR/SZ)tt2 
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F  =  ( (ZBAR-2.*DW)/SZ)t*2 
6=<<ZBAR+2.tDW>/SZ)**2 

CONC=CSAT*EXP<-A>*<EXP<-B>+EXP<-C>+EXP(-D))t<EXP(-E)+EXP<-F)+EXP<- 

1G)) 

PLCNX=US*T 

RETURN 

END 

SUBROUTINE  TSPRD(DENL*DIA*HGT * FLOW* TIME  <IZE> 

THIS  SUBROUTINE  CALCULATES  THE  POOL  RADIUS  AS  A  FUNCTION  OF  TIHE 
FOR  AN  INSOLUBLE*  LIGHTER-THAN-WATER  CHEMICAL  WITH  BOILING  POINT 
GREATER  THAN  AMBIENT  SPILLED  CONTINUOUSLY  ONTO  WATER.  IT  WORKS 
ONLY  FOR  RADIAL  SPREADING. 


***  INPUTS  *** 

DENL  DENSITY  OF  SPILLED  CHEMICAL 
DIA  AVERAGE  DIAMETER  OF  HOLE 

HGT  HEIGHT  OF  HOLE  ABOVE  WATER 

FLOW  CONTINUOUS  MASS  RATE  OF  FLOW 
TIME  TIME  AT  WHICH  POOL  RADIUS  DESIRED 

<M  OUTPUTS  *** 

SIZE  RADIUS  OF  POOL  AT  SPECIFIED  TIME 


GM/CM3 

CM 

Bm/sec 

SECS 


CM 


mmm* 

PI*3. 141592654 
G=980 . 

BENW=1 .0 

CALCULATING  THE  JET  ENTRY  PARAMETERS*  HYDRAULIC  JUMP  RADIUS 
AND  THE  RADIAL  OUTFLOW  VELOCITY. 

FLW=FLOW/DENL 

U=SQRT(<VEL**2.)+(2.*G*HGT>) 

A=DIA*SQRT(VEL/U)/2. 

HB=A/2 . 

FB=2.*U*U/<GRAV*A> 

FA=8.*FB/((S0RT((8.*FB)4-1.)-1.)**3.) 

HA=HB*<FB/FA)«(l./3.) 

UA=U*HB/HA 

CALCULATING  THE  RADIAL  SPREAD  PARAMETERS. 

TCH=A/UA 
TAU=TIME/TCH 


|-Ug«j}/(HM6RAV> 


E0*0.6B 

PSI1=SQRT(2./(1.-(2.IE1)))*SQRT(TAU-((F*E1)/((1.-E1-E1)«2.))) 
CHI=PSIl+l . 

SIZE«CHI*A 

RETURN 

END 

0VERLAY(10*5) 

PROGRAM  MODV 

SUBROUTINE  MODV  OBTAINS  DATA  FOR  THE  EXECUTION  OF  SUBROUTINE 
PKRHI *  WHICH  CALCULATES  THE  CONDITIONS  AFTER  WHOSE  BOILING 
POINT  IS  GREATER  THAN  AMBIENT 


COMMON/C/PLTYP*XBX< 150) 

£imI§1iONPU(20),AV<20)*AS(20>*ATEM<20>*AER<20>*AR(20) 

DIMENSION  ASAV(20) * ASAVT(20) *  PTITL1(6)*PTITL2<6)*PTITL3(&)* 
1PTITL4<6) *PTITL5(6) >XTITL(6) *XTITL1 (6) *YTITL1 (6) * YTITL2<6) * 

‘iHwatenwttisHiMit  XPX ( 21 > * AV ( 1 ) > »  (XBX ( 41 ) * AS( 1 ) ) * 

1  <  XBX (61) * ATEM< 1 ) ) * ( XBX (81 ) * AER( 1 ) ) * ( XBX ( 101 ) * AR( 1 ) ) 

EQUIVALENCE  (XBX( 121 ) *ASAV< 1 ) ) 
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DATA  M0D/4H  V  / 

ODATA  (PTITLl(I) .1=1. 6)/8HP00L  RAD. 8HIUS/LENG 
18HME  -  M0D.8HEL  V  ,1H  / 

ODATA  (PTITL2(I)«I=1» 6 )/8HV0LUME  0.8HF  LIQUID 
18HMG  VS  TI.8HME  -  M0D.8HEL  V  f 
ODATA  (PTITL3< I > » 1=1 »6)/8HEVAPQRAT*8HIQN  RATE 
18H  -  MODEL. 8H  V  , 1H  / 

ODATA  (F'TITL4(I>  .I=1«6)/8HPQ0L  ARE.8HA  VS  TIM 

0$a¥a  <  PT I TL^  <* I ) .  ? = 1 » 6 ) /BHTERPERAT » 8HURE  OF  L 
18H  TIME  -  .8HMQDEL  V  >1H  / 

ODATA  f XTITL  ( I >  > 1=1 .6)/8HELAPSED  .8HTIME  FRO 

18H0F  SPILL. 8H . . . ( .8HMINUTES)/ 

ODATA  (XTITL1 ( I ) » 1=1 . 6)/8HELAPSED  . 8HTIME  FRO 

18H0F  SPILL. 8H . ,8H.  (HOURS)/ 

ODATA  <YTITL1(I).I=1.6)/8H  RADIU.8HS/LENGTH 
18HF  POOL  >8H  ( .8HMETERS)  / 

ODATA  (YTITL2(I).I  =  1»<4)/1H  »8H  VOLUME  »8H 
18HMAINING  .1H  .8H  <N**3)  / 

ODATA  < YTITL3< I ) *  1  =  1. A)/8H  EVA.8HP0RATI0N 

18H  RATE.8H  (.8HKB/SEC)  / 

ODATA  (YTITL4(1).I=1»6)/1H  .8H  AREA  »1H  , 
18H0F  POOL  .1H  »8H  (MM2)  / 

ODATA  (YTITL5< I > .1=1 .6)/8H  TEMP.8HERATURE 


ODATA 


»8HTH  VS  TI» 
»8H  REMAINI. 
»8H  VS  TIME. 
>8HE  MODEL  . 
. 8HIQUID  VS. 
>8HM  START  . 
»8HM  START  > 


.1H  . 


ODATA  ( YTI1 
18H  LIQUID 


CONTINUE 

CALL  TRACE (0.8 .5) 

IR=0 

Lf'-A 

IR=6 


.8H(DEG  C>  / 


TEMP.8HERATURE 


OBTAIN  DATA 

CALL  BEGPR(MOD) 

CALL  FRCL< 1002.XM0L. IS.IR) 

AM=XMDL 

CALL  FRCLU004.DENL. IS.IR) 

IF (DENL-1 .0)  40.30.30 
30  CALL  PAGER(4) 

WRITE(LP.IOO) 

40  CONTINUE9 

CALL  FRCL(1006»VISL» IS.IR) 

I0UT-0 

CALL  FRCL(I007»CL. IS.IR) 

CALL  FRCL(IOIO.A.IS.IR) 

CALL  FRCL(IOU.B.IS.TR) 

CALL  FRCLU012.C. IS.IR) 

CALL  FRCLU031.SURT. IS.IR) 

CALL  FRCL(2004. TINT. IS.IR) 

CALL  FRCL(2020»CHNLW. IS. IR) 

CALL  FRCL<2023»TW. IS.IR) 

CALL  FRCL(2033.CFIR. IS.IR) 

CALL  FRCU2054.TA. IS.IR) 

TMAX=TW 

IF(TA.GT.TMAX)  TMAX=TA 
IF(TINT.GT.TMAX)  TMAX=TINT 
PRES=10.**(A-(B/(TMAXFC>)> 

CONC=100,*PRES/760. 

CALL  FRCL(2057. TIME. IS.IR) 

I S  1=6 

CALL  FRCL(4003.V0LI»IS1»IR) 

- 1F  VOLUME  IS  NOT  A  DEFAULT.  USE  GIVEN  VALUE 

OTHERWISE.  COMPUTE  USING  MASS  AND  DENSITY 
IF(ISl.GT.l)  GO  TO  300 
CALL  PAGER(l) 

mmmn  a  .SPAMT. IS.IR) 

VOLI=SPAMT/DENL 
CALL  FSV(4003.VOLI.4) 
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I S 1  =  4 

300  IFdS.GT » I SI >  IS=ISl 
CALL  PAGER  d) 

URITE(LP*21 ) 

CALL  COHPD(AM.TA,DENLB»DIFCO) 

CALL  FSV<2053.DIFC0r4) 

CALL  FRCL<2053» DIFCOflSf IR) 

CALL  IRCL(3010dVPF»ISdR) 

m  fflWWfcHiliiW*’ 

IFdL.EQ.l)  GO  TO  99 
IFdL  .EQ.2)  GO  TO  2 
I0UT=0 

CALL  PKRHI 
23  IDIH=2 

CALL  PKRHI (IDIMfCHMLUtVOLI iDENL»VISL»SURT»XLAT»CL»A»B»CfTW»TIME»DI 
1 FCO . XMOL  t  VOL i SI ZE » TEMP » SPEVA  f  TMEND . ARE A » I OUT ) 

DIAM=2.*SIZE 

IF(DIAM.LE.CHNLW)  GO  TO  20 

CALL  PKRHI ( IDIMfCHNLHf VOLI »DENL»VISL»SURT» XLAT fCL» AfBfCfTWfTIMEfDI 
IFCOfXMOLf VOL .SIZE f TEMP fSPEVAf TMEND f AREA fIQUT) 

20  XCTIM=TMEND+101. 

IFdIME.LT .XCTIM)  GO  TO  22 
TIME=TMEND+100 . 

GO  TO  23 

UPDATE  DATA  BASE 

22  CALL  OUTPR(MOD) 

IFdDIM.NE.2)  GO  TO  8 
CALL  PAGER<1) 

URITE(LPdl) 

8  IFdDIM.NE.l)  GO  TO  9 
CALL  PAGER  d) 

WRITE (LPf 12) 

9  CALL  ISV(2018fIDIMf4) 

CALL  FSV(402AfV0Lf4) 

CALL  FSV(4027»SIZE»4) 

CALL  FSV(4028fTEMPf4) 

CALL  FSV<4029.SPEVAf4) 

CALL  FSV(4030fTMENDf4) 

CALL  FSV(4031 fAREAf4) 

AVTEM=dINT+TEMP)/2. 

CALL  FSV ( 4068 » AVTEM » 4 ) 

IF(CONC.LT.CFIR)  CALL  PAGER(3) 

IF(CONC.LT.CFIR)  WRITE<LPf200> 

IF(CQNC.LT.CFIR)  CALL  FSV<2033f0.0f6) 

CALCULATE  AND  SAVE  AVERAGE  VAPOR  EVOLUTION  RATE  UP  TO  USER 
SPECIFIED  TIME  OR  OVER  TIME  IT  TAKES  POOL  TO  COMPLETELY  VAPORIZE 
AND  SAVE  IT  AND  THE  TIME  IN  CASE  MODEL  W  FOLLOWS. 

TMX»TIME 

IF(TMEND.LT.TMX)  TMX=TMEND 
IF(TMX.EQ.TIME)  FLOW=(VOLI-VOL)*DENL/TMX 
IFdMX.EO. TMEND >  FLOW«VOL IIDENL/TMX 
IFdMX.NE.TIME)  GO  TO  5 
CALL  PAGER (3) 

WRITE(LP» 13) 

5  IFdMX.NE. TMEND)  GO  TO  6 
CALL  PAGER(3> 

HRITE(LPd4) 

4  m  mumsaRit1 

IFITMX.LT .600. )  CALL  ISV(2061f0f4) 

IFdMX.GE . 600, )  CALL  ISV<2061 f 1 f4> 

IDM=IDIM 
CALL  ENDPR(MOD) 

INTERROGATE  USER  PLOT  REQUEST  FLAG 
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IF ( IVPF.EQ.O. AND. ITAB.EQ.O)  60  TO  99 


SET  UP  LOOP  FOR  CALCULATION  OF  PLOT  ARRAYS  OF  VOLUME ,  SIZE* 
TEMPERATURE*  SPECIFIC  EVAPORATION  RATE  AND  AREA  OF  SPILL 
VERSUS  ELAPSED  TIME 

DT=.95*TMEND/19, 

IDIM=2 
STM=0.0 
DO  10  1=1*20 

AT<I)=FL0AT<I-l)*DT+!TMEND/20.) 

IF!I.EQ.20)  AT<20)=TMEND+100,0 

CALL  PKRHI ( IDIM*CHNLU, VOLI » DENL* VISL*SURT*XLAT *CL* A*B*C*TW* AT! I ) * 

1  DIFCO  * XMOL *  AV  < I > , AS  < I ) *  ATEM ( I ) *  AER  < I ) » TMNDE *  AR ( I ) * IOUT ) 

DIAM=2.IAS(I ) 

IF!DIAM.GT .CHNLW. AND.STH.EQ.0.0)  STM=AT!I)/60. 

IFISTM.GT.O.O)  IDIM=1 
AT!20)=TMENB 
10  CONTINUE 

ATEM!20)=<2,*ATEM!19))-ATEH!1B> 

AER<20)=(2.*AER(19))-AER<18> 

WRITE  PLOT  FILE 
IFUVPF.EG.O)  GO  TO  1 
DO  70  1=1*20 
70  ASAVT !I)=AT(I)/60. 

DO  71  1=1*5 
DO  72  11=1*20 

IF(I.EQ.l)  ASAV(II)=AS(II)/100. 

IFCI.EQ.2)  ASAV! I I )=AV< II 1/1000000.0 
IF(I.EQ.3)  ASAV( II )= ( AER( II )/1000. 1*AR! II 1 
IF!I.EQ.41  ASAV! II 1=AR! II 1/10000. 

IF(I.EQ*5)  ASAV! II 1=ATEM! II 1 
72  CONTINUE 
IF(I.EQ.l) 

1CALL  PLTLP!PTITL1 *ASAVT  *ASAV*20*XTITL* YTITL1 *  1  *  60*  *XTITL1 ) 

I F  < I » EO  *  2 ) 

1CALL  PLTLP!PTITL2* ASAVT  * ASAV*20*XTITL* YTITL2* 1 *60. *  XTITL1 ) 
IF!I.EQ.3> 

i^ALy  P^TljP(PTITL3,  ASAVT  * ASAV*20*XTITL* YTITL3* 1 *60. *XTITL1 ) 

1CALL*PLTLP(PTITL4* ASAVT, ASAV»20*XTITL» YTITL4  *  1 *60. *XTITL1 ) 
IF(I.EQ.5) 


ICALL  PLTLP!PTITL5* ASAVT, ASAV,20*XTITL* YTITL5* 1 *60. *XTITL1 > 
IFTI.NE.I. AND. IBIM.NE.il  GO  TO  7 
CALL  PAGERI41 

IF(STM.GT.O.O)  WRITE!LP,64)  STM 
7  IF < I ,NE,4. AND, IDIM.NE.  1 )  GO  TO  71 
CALL  PAGER (4) 

IF(STM.GT.O.O)  WRITE!LP,64)  STM 
71  CONTINUE 

- SET  UP  OFF-LINE  PLOT 

PLTYP=1  • 

1  CONTINUE 

WRITE  TABLE  IF  REQUESTED 

IF(ITAB.EQ.O)  GO  TO  99 
CALL  PAGER! 0) 

CALL  PAGER!51 
URITE(LP,60) 

CALL  PAGER! 1) 

URITE!LP,61 ) 

CALL  PAGER!2) 

WRITE(LP*A2) 

SSZ=0.0 

DO  50  1=1*20 

TMNS=AT!I)/A0, 

SM=AS(I)/100. 
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SFT=AS<I)/(2.54*12.> 

EVAP=AER ( I ) >AR( I )/1000. 

AREA=AR( I )/l 0000.0 
CALL  PAGER(l) 

URI TE ( LP . 63 )  TMNS , SH » SFT . ATEM (I) » EVAP . AREA 
50  CONTINUE 

IF ( STM.GT .0.0 )  CALL  PAGERU) 

IF (STM.GT .0,0)  WRITE(LP»64)  STM 
GO  TO  99 

11  FORMAT ( 1X.29H  THE  SPILL  POOL  IS  CIRCULAR.  ) 

12  FORMAT < 1X.46H  THE  SPILL  POOL  IS  CONFINED  BY  CHANNEL  BANKS.  ) 

13  FORMAT ( / 1 X » 64HTHE  VAPOR  EVOLUTION  RATE  AT  THE  USER  SPECIFIED  TIME 
1AND  THE  TIME/1X.34HARE  SAVED  IN  CASE  MODEL  U  FOLLOWS. ) 

14  FORMAT (/1X.66HTHE  AVERAGE  VAPOR  EVOLUTION  RATE  WHILE  THE  POOL  EVAP 
10RATES  AND  THE/1X.70HTIME  FOR  IT  TO  COMPLETELY  EVAPORATE  ARE  SAVED 

1  IN  CASE  MODEL  W  FOLLOWS.) 

21  F0RMATUX.56HTHE  DIFFUSION  COEFFICIENT  OF  VAPOR  IN  AIR  IS  CALCULAT 
1ED./1X»46H(VALUE  IS  DISPLAYED  ON  STORAGE >  THEN  RETRIEVAL  / 

2  2X.34HT0  SHOW  USER  OVER-RIDE  IF  PRESENT)) 

310  FORMAT  (1X.50HTHE  LIQUID  VOLUME  IS  COMPUTED  AS  THE  MASS/DENSITY.) 

60  FORMAT (//36X.42HTABLE  OF  POOL  CONDITIONS  VS  TIME  -  MODEL  V//) 

61  FORMAT (20X .4HTIHE. 10X.4HSIZE* 10X.4HSIZE.10X.4HTEMP.8X.9HEVAP  RATE. 
17X.4HAREA) 

62  FORMAT ( 19X. 6H (MINS ). 10X. 3H(M) . 10X.4H( FT )»9X»7H(DEG  C) »7X.8H(KG/SEC 
631^6^^tl(liPx,fil0.>4.5(4X.G10.4)) 

64  FORMAT (//17X.44HN0TE  -  DURING  THE  TIME  INTERVAL  BEFORE  TIME=.G10.4 
1.6H  MINS./17X. 38HTHE  POOL  IS  CONFINED  BY  CHANNEL  BANKS.) 

100  FORMAT ( 96H  WARNING-  THE  LIQUID  DENSITY  OF  THE  SPILLED  CHEMICAL  IS 
*S0  CLOSE  TO  WATER  THAT  IT  MAY  OR  MAY  NDT/77H  FLOAT.  FOR  MODEL  V  IT 
*  WILL  BE  ASSUMED  THAT  IT  HAS  A  DENSITY  OF  0,99  GM/CMM3//) 

200  FORMAT ( 72H  NOTE-VAPOR  PRESSURE  OF  LIQUID  IS  TOO  LOW  TO  FORM  FLAMMA 
1BLE  VAPOR  CLOUD./  53H  LOWER  FLAMMABLE  LIMIT  SET  TO  ZERO  BEFORE  PRO 
2CEEDING./) 

99  CALL  TRACEU.8.5) 

END 

SUBROUTINE  FCT (X. Y.DERY. AI .ZMI .TEMPS.TIMEC. DEL.BETA.THETW. IDIM. 
1CHNLU. VOLI »DENL* VISL.SURT.SIZE.A) 

C  m  THIS  SUBROUTINE  IS  CALLED  BY  THE  RKGS  SUBROUTINE  FOR  THE  EVALUATIO 
C  ***  OF  THE  RIGHT  HAND  SIDE  OF  THE  SYSTEM  OF  THE  DIFFERENTIAL  EQUATIONS 
C  *#*  IN  THIS  CASE  THE  RHS  FUNCTIONS  ARE  THE  ONES  THAT  GIVE  THE  TEMPERAT 
C  ***  DECREASE  RATE  AND  THE  MASS  DECREASE  RATE  FOR  THE  HIGH  VAPOR  PRESSU 
C  ***  LIQUID  SPILL 


w§mY2^'DERY<5) 


PI=3. 141592653 

ETA=EXP<-BETA4< 1 ./Y( 1 )  -1 ,/THETW) ) 

T IME-X4TIMEC 

C  ***  OBTAINING  THE  AREA  OF  THE  POOL  FROM  SPREAD  MODELS  *** 

CALL  RL JSP (IDIM. VOLI. DENL.VISL.SURT. TIME. CHNLU. SIZE) 

GO  TO  (5. 10). IDIM 

C  *t*  A  IS  THE  NON  DIMENSIONAL  AREA  —NON  DIMENSIONLISED  WITH  RESPECT 
C  ***  THE  INITIAL  CHARACTERISTIC  AREA  -AI— . 

5  A=SIZE*CHNLW/AI 

C  ***  C  IS  THE  CORRECTION  FACTOR  WHICH  TAKES  INTO  ACCOUNT  THE  NON  UNIF 
C  ***  THERMAL  BOUNDARY  LAYER  THICKNESS  IN  WATER  DURING  THE  SPREADING. 
C*PI/2, 

GO  TO  15 

10  A=PI*SIZE**2/AI 
C~2  ♦ 

C  ***  DERIVATIVE  FUNCTIONS  *** 

15  IF(X) 16. 16. 17 

16  DERY(1)=-A*ETA 
GO  TO  18 

17  is  ^^^i:AJJ^^*c,(THETW“Y<1,>/SQRT<x>_ETA,/Y(2) 

RETURN  ' 

END 

C  *4*  THIS  IS  AN  OUTPUT  SUBROUTINE  CALLED  BY  THE  RKGS  SUBROUTINE, 

C  t**  THIS  ROUTINE  IS  USED  HERE  TO  WRITE  THE  CALCULATED  VALUES  OF  THE 


C  *** 
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C  m  EVAPORATION  RATE, MASS  REMAINING  ETC  AT  EVERY  INSTANT  OF  TIME. 

C  ***  X.Y.DERY  ARE  ALL  IN  NON  DIMENSIONA  UNITS.  THE  OUTPUT  VALUES  ARE  I 
C  ***  IONAL  UNITS 

c  ********************************************************************** 

C  ***  TIME  AT  WHICH  THE  ANSWERS  ARE  WRITTEN  SECS 

C  ***  TEMP  TEMPERATURE  OF  THE  LIQUID  AT  THE  TIME  INDICATED  DEG  C 

C  ***  FRMAS  FRACTION  OF  THE  INITIAL  MAAS  REMAINING  IN  THE  SYSTEM 

C  ***  ZMAS  MASS  REMAINING  IN  THE  SYSTEM  GMS 

e  !!!  i?ie.  n  TjiEEi!Mwmc?fts/SEcc 

C  ***  IOUT  A  FLAG  WHICH  INDICATES  IF  THE  OUTP  ROUTINE  IS  TO  EXECUTED 

C  ***  IHEAD  A  FLAG  WHICH  INDICATES  IF  THE  HEADING  IS  TO  BE  WRITTEN  OR 

c  ******************************************************************** ** 

c 

DIMENSION  AUX(8 ,  2) , Y(5) »DERY(5) ,PMRT (5) 

LP=6 

C  IF\AUX\5,2"  10.10.30  CHANGED  TO  CARD  BELOW  04/24/73 

IF  ( Y ( 2 ) )  10,30.30 
10  PMRT (5)=5. 

20  RETURN 

30  IF (IOUT)  20,20,40 

40  IF ( IHEAD)  70,70,60 

60  CALL  PAGER (3) 

WRITE(LP,200> 

70  PI=3. 141592653 

TIME=X*TIMEC 
TEMP=Y ( 1 )*TEMPS-273. 

FRMAS=Y(2) 

ZMAS=ZMI*FRMAS 

AREA=A*AI 

SPEVA=0. 

IF < A)  90,90,80 

SO  SPEVA=-ZM I*DERY <  2 )  / (TIMEC*AREA ) 

90  CALL  PAGER ( 1 ) 

WRITE ( LP, 100 )  TIME, FRMAS, ZMAS, SPEVA, AREA, IHLF 
RETURN 

100  FORMAT ( 2X.E14 .5,  2X,  2(E14.5,4X) ,2X,E14.5,8X,E14.5,4X,I2) 

200  F0RMAT(6X, 4HTIME, 12X, 1 1HFRACTN  MASS,6X,14HREMAINING  MASS.6X, 14HSPE 
1CIFIC  EVAPN , 9X , 9HP00L  AREA/6X , 4HSECS,33X,5HGRAMS, 1 3X, 12H6M/SECrCM* 
2*2,13X,5HSQ  CM//) 

IDEroutine  PKRHI(IDIM,CHNLW,VOLI,DENL,VISL,SURT,XLAT,CL,A,B»C,TW, 
1TIME,DIFC0,XM0L, VOL, SIZE, TEMP, SPEVA, TMEND, AREA, IOUT) 

C  ********************************************************************* 
C  ***  THIS  SUBROUTINE  CALCULATES  THE  CONDITIONS  AFTER  THE  SPILL  OF  A  HIG 
C  ***  VAPOR  PRESSURE  LIQUID  ON  WATER,  FOR  A  GIVEN  SPILL  VOLUME  AND  TEM 
C  ***  THE  SUBROUTINE  RETURNS  THE  SIZEOF  SPREAD, THE  VOLUME  REMAINING, 

C  ***  AND  THE  EVAPORATION  RATE  OF  THE  LIQUID,  THE  CLAUFTUS  CLAYPERON 
C  ***  EQUATION  FOR  SATURATED  VAPOR  PRESSURE  IS  UTILIZED. 


C  ************  ARGUMENT  DESCRIPTION  ***************** 
C  *****  INPUT  VALUES  ************* 

C  ID I h  DIMENSION  OF  THE  SPREAD  1-DIMENSIDNAL=1  RADIAL=2 

C  CHNLW  CHANNEL  WIDTH  CM 
C  VOL  I  INITIAL  VOLUME  CUBIC  CM 

C  DENL  DENSITY  OF  THE  SPILLED  LIQUID  G/CC 
C  VISL  VISCOSITY  OF  THE  SPILLED  LIQUID  DYNE-SEC/CM 
0  SURT  SURFACE  TENSION  OF  THE  SPILLED  LIQUID  DYNES/CM 
i:  XLAT  HEAT  OF  VAPORIZATION  OF  THE  SPILLED  LIQUID  CAL/GM 


C  CL  SPECIFIC  HEAT  OF  THE  SPILLED  LIQUID  CAL/GM-DEGREE  K 
C  A»B»C  CONSTANTS  IN  THE  SATURATED  VAPOR  PRESSURE  EQUATION 

C  P=10.**(A-(B/(T+C)>) 

C  TW  TEMPERATURE  OF  WATER  DEGREES  C 

C  TIME  TIME  AT  WHICH  THE  CONDITIONS  ARE  TO  BE  KNOWN  SEC 

C  DIF  CO  DIFFUSION  COEFFICIENT  OF  VAPOR  IN  AIR  SQ  CM/SEC 

C  XMOL  MOLECULAR  WEIGHT  OF  SPILLED  COMPOUND  GM/MOL 

C 

C  *****  OUTPUT  VALUES  **** 

C  TMEND  TIME  AT  WHICH  PROGRAM  STOPS  -  SPECIFIED  TIME  OR  TIME  AT  WH 

C  ALL  LIQUID  HAS  EVAPORATED  -  WHICHEVER  COMES  FIRST  SEC 

C  VOL  VOLUME  OF  THE  LIQUID  REMAINING  AT  TMEND 

C  SIZE  SIZE  OF  THE  SPILL  AT  TMEND  (RADIUS  OR  LENGTH)  CMS 
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HMTC(DIFCO»XMOL»VQLI *HMP> 


C  SPEVA  SPECIFIC  EVAPORATION  RATE  AT  TMEND  GM/SEC  C 

AREA  AREA  OF  THE  SPILL  AT  TMEND  SQUARE  CM 

*****  INPUT/OUTPUT  VALUES  »*** 

IOUT  1  IF  WANT  INTERMEDIATE  VALUES  OF  VOL,  SIZE,  TEMP 
0  IF  ONLY  WANT  FINAL  VALUES 

VALUE  MAY  BE  CHANGED  WITHIN  SUBROUTINE  CALLED  BY  THIS  ONE 

t******************************************************************** 

EXTERNAL  OUTP,  FCT 
DIMENSION  PMRT(5),Y(5),AUX(8,2  >,DERY<5> 

FACT  =  10 . 

NSEC=50 
CALL 
DENW=1 .0 
CONDW= . 0013 
PI  =  3  141590653 

C  ****  CALCULATION  OF  CHARACTERISTIC  AND  NON  DIMENSIONALING  PARAMETERS 
ALFW=CONDW/DENU 
ZMI=VOLI*DENL 
AI=FACT*V0LI**0.666667 
TEMPS=XLAT/CL 

PVAPI  =  d0.**(A-(B/(TW+C))>>/760, 

EIDOT=HMF’*PVAP  I 
TIMEC=ZMI/(AI*EIDOT) 

TOUEN=TIME/TIMEC 

DEL-CONDW*TEMPS/ (EIDOT*XLAT*SQRT (F‘1*ALFW*TIMEC) ) 

BETA=B/TEMPS 

THETW=<TW+273.)/TEMPS 

C  ***  INTEGRATION  OF  THE  SIMULTANEOUS  SYSTEM  OF  DIFFERENTIAL  EQUATIONS 
C  ***  Y(l)  IS  THE  TEMPERATURE  AND  Y ( 2 )  IS  THE  MASS  OF  THE  LIQUID  *** 

C  ***  FiRST  THE  INITIAL  CONDITIONS  AND  ERROR  WEIGHTS  ARE  GIVEN  *** 

2000  Y ( 1 ) =THETW 
Y(2)  =  l . 

NDIM-2 
PMRT d  )=0 . 

PMRT  (2) =TQWEN 

PMRT (3)=T0UEN/FL0AT (NSEC) 

PMRT ( 4 ) = . 005 
DERY  d ) =0 . 5 
DERY (2) =0.5 

CALL  PKRRK (PMRT, Y, DERY, NDIM,IHLF, FCT, OUTP, AUX , AI , ZMI ,TFMPS , 

1TIMEC, DEL, BETA, THETW , IDIM , CHNLW, VOLI, DENL,VISL,SURT, SIZE, S, IOUT, X) 
FRMAS=AUX(1 ,2) 

ZMAS=ZMI*FRMAS 

VOL=ZMAS/DENL 

TEMP=AUX ( 1 , 1 )*TEMPS-273 . 

AREA=S*AI 
SPEVA=0 . 

IF ( S)  90,90,80 

80  SPEVA=-ZMI*AUX(2,2)/(TIMEC*AREA) 

90  TMEND=X*TIMEC 

RETURN 
END 

SUBROUTINE  PKRRK (PRMT , Y ,DERY,NDIM, IHLF ,FCT , OUTP, AUX, AI , ZMI , TEMPS, 
1TIMEC, DEL, BETA, THETW, IDIM, CHNLW, VOLI, DENL,VISL,SURT, SIZE, S, IOUT, X) 
C 

EXTERNAL  FCT  ,OUTP 

DIMENSION  Y(5> ,DERY<5) »AUX(8»  2) ,A<4> ,B( 4) ,C(4) ,PRMT(5) 

DO  1  1=1 »NDIM 

1  AUX (8, 1 )  = . 06666667*DERY  < I ) 

X=PRMT ( 1 ) 

XEND=PRNT (2) 

H=PRMT (3 ) 

PRMT (5)=0. 

CALL  FCT ( X, Y, DERY, AI, ZMI, TEMPS, TIHEC, DEL, BETA, THETW, IDIM, 

1CHNLW, VOLI, DENL,VISL,SURT, SIZE, S) 
r  cppnp  TFST 

c 

2  A( 1 )* .5 
A(2)=. 2928932 


-KUTTA  METHOD 
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A(3)-l . 707107 
A(4)=. 1666667 
B(  1 )=2< 

B  <  ?. )  =  t  • 

B<3)=1. 

B<4>=2. 

('{ 1  )  =  .5 
C<2)=. 2928932 
C(3)=l. 707107 
C<4>=.5 

PREPARATIONS  OF  FIRST  RUNGE-KUTTA  STEP 
DO  3  1=1 fNDIM 
AUX( 1  *  I )=Y ( I ) 

AUX(2»I)=BERY(I) 

AUX(3»I)=0. 

3  AUX(6fI)=0. 
rREC=0 
H=H+H 
1HLF=-1 
ISTEP=0 
IEND=0 

RECORDING  OF  INITIAL  VALUES  OF  THIS  STEP 
IHEAD=1 

CALL  OUTP(XfYfDERYfAIfZMI»TEMPSfTIMEC»AUXfBETAfTHETWfIBIMf 

ICHNLUfVQLIfDENLf VISLfSURT  fSIZEfS  fIRECfNDIMfPRMTf IOUT.IHEAD) 
1HEAD=0 

START  OF  A  RUNGE-KUTTA  STEP 

4  IF(<X+H-XEND)*H)7f6f5 

5  H=XEND-X 

6  IEND=1 
CONTINUE 

IF(PRMT(5))40»8»40 

8  ITEST=0 

9  ISTEF'=I STEP+1 

START  OF  INNERMOST  RUNGE-KUTTA  LOOP 
J=1 

10  AJ=A<  J> 

BJ=B( J) 

CJ=C( J) 

DO  11  I=1fNDIM 

I^AJ^Rl-ijlrAUXlAfl)? 

Y ( I )=Y  < I ) +R2 
R2=R2FR2+R2 

AUX(6fI)=AUX:6»IHR2-CJ*R1 
IF ( J-4) 12 » 1 5 » 1 5 
J=J+1 

1F(J-3)13»14»13 
X  =X+ 

CALL’  FCT1X  f Y»  DERY f Al » ZMI f TEMPS fTIMECf DEL f BETA fTHETWf I DIM* 

ICHNLWf VOLIr DENL  f  VISL  f SURT  f  S IZE  f  S ) 

GOTO  10 

C  ENP  OF  INNERMOST  RUNGE-KUTTA  LOOP 

C  TEST  OF  ACCURACY 

15  IF<ITEST)16»16f20 

IN  CASE  ITEST=Q  THERE  IS  NO  POSSIBILITY  FOR  TESTING  OF  ACCURACY 
DO  17  I=1fNDIM 
AUX<4  f I )=Y( I > 

ITEST=1 

ISTEP=ISTEP+ISTEP-2 
IHLF=IHLF+l 

:<=x-h 

H=.5*H 

DO  19  I=1fNDIM 
Y(I)=AUX(1fI) 

DERY(I)=AUX<2fI> 

AUX (6f I )=AUX(3» I ) 

GOTO  9 

MoSSflTfBP'1  TESTING  0F  ACCURACY  IS  POSSIBLE 
IF(ISTEP-IM0D-IM0D)21f23f21 

CALL  FCT(XfYfDERYfAIfZMIfTEMPSfTIMECfDELfBETAfTHETWfIDIMf 


11 

12 

13 

14 


16 

17 


18 


19 


20 

21 
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c  *** 
c  m 


1CHNLW, VOLI , DENL»VISL,SURT»SIZE»S) 

DO  22  1  =  1 » NDIH 
AUX(5» I )=Y  < I ) 

AUX(7» I > =DERY ( I ) 

GOTO  9 

COMPUTATION  OF  TEST  VALUE  DELT 
DELT=0. 

DO  24  I =1 i NDIM 

DELT=DELT+AUX<8» I )*ABS< AUX<  4, 1 >-Y  < I ) ) 

IF (DELT-PRMT (4) )28»28»25 

ERROR  IS  TOO  GREAT 

IF(IHLF-10)26»36,36 

DO  27  I  =  1 » NDIM 

AUX ( 4 1 1 ) =AUX<  5  , I ) 

lSTEP=ISTEP+ICTEP-4 

X=X-H 

[FND=0 

GOTO  18 

RESULT  VALUES  ARE  GOOD 

CALL  FCT(X»  Y»  DERY, AI»  ZMI .TEMPS »TIMEC, DEL, BETA, THETW, I DIM, 

1CHNLU, VOLI ,DENL» VISL ,SURT  , SIZE  »S) 

CALL  OUTPIX , Y,DERY» AI »ZMI , TEMPS »TIMEC» AUX .BETA, THETW, I  DIM, 

1CHNLW»V0LI »DENL»VISL»SURT , SIZE»S  , IREC»NDIM,PRMT  , IOUT » IHEAD) 
CHECK  IS  MADE  IF  THE  NEXT  MASS  VALUE  IS  NEGATIVE.  IF  SO  CALCULATI 
IS  STOPPED  BY  GOINT  TO  LINE  50. 

ISKIP=PRMT<5V7. 

IFIISKIP-2)  55,50,55 
DO  29  1=1 » NDIM 
AUX< 1 » I )=Y ( I ) 

AUX (2,1 )=DERY ( I ) 

AUX  C  3 1 1 ) =AUX  <  6  r I ) 

Y (I  )=AUX(5»I ) 

DERY ( I ) =AUX(7  *  I ) 

I F'  < PRUT  (5) ) 40 > 30.40 
DO  31  1=1, NDIM 
Y<i)=Auxn,i> 

DERY  < I >  = AUX (2*1 ) 

IREC=IHLF 

IF ( IEND ) 32  f  32  r  39 

INCREMENT  GETS  DOUBLED 


40 

c  m 
c  ttt 

cTo 

c  *** 
c  *** 


H=H+H 

IF(IHLF)4,33,33 

IM0D=ISTEP/2 

IF ( I  STEP- 1 MOB- 1 MOD) 4, 34, 4 

IF ( DELT- .02IPRMT  <  4 ) ) 35 , 35  r 4 

IHLF=IHLF-1 

ISTEP=ISTEP/2 

H=HFH 

GOTO  4 

RETURNS  TO  CALLING  PROGRAM 

CALL”11  FCT(X»  Y» DERY, AI »ZMI .TEMPS, T I MEC, DEL, BETA, THETW, IDIM, 

1CHNLH,V0LI,DENL,VISL,SURT,SIZE,S) 

GOTO  39 
IHLF=12 
GOTO  39 
IHLF  =  13 

CALL  OUTP(X,Y, DERY, AI.ZMI, TEMPS, TIMEC, AUX, BETA, THETW, IDIM, 

1CHNLW,  VOLI ,DENL, VISL.SURT , SIZE,S  ,IREC, NDIM, PRMTr IOUT, IHEAD) 

RETURN 

DIFM  AND  DIFT  ARE  THE  AVERAGE  VALUES  OF  THE  RATE  OF  CHANGE  OF  MAS 
RATE  OF  CHANGE  OF  TEMPERATURE, RESPECTIVELY  BETWEEN  THE  LAST  STEP 

»»B-T8BxT5?i S?> T3!  "#ss  60ES  NEE#T"'E' 

DIFT  =  (AUX (2, 1 ) +DERY ( 1 ) ) /2 , 

DX  IS  THE  TIME  BETWEEN  THE  LAST  TIME  AND  THE  TIME  AT  WHICH  THE  MA 
GOES  TO  ZERO 
DX=  <  0 . -AUX< 1 , 2  > ) /DIFM 
X=XfPX 
AUXU,2>=0. 
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AUX ( 1 , 1 ) =AUX (1*1) PDIFTtDX 

RETURN 

END 

OVERLAY < 10 »6> 

PROGRAM  MODX 


PROGRAM  EXECUTES  MODEL  X.  INDEX  24 


MODX  CALCULATES  THE  CONDITIONS  FOLLOWING  A  SPILL  OF  A  HEAVIER- 
THAN-WATER, SLIGHTLY  SOLUBLE  CHEMICAL  WITH  A  BOILING  POINT  GREATER 
THAN  THE  AMBIENT  TEMPERATURE.  SEE  ROUTINES  SINK1.SINK2,  AND 
SINK3  FOR  SPECIFIC  CAPABILITIES. 

COMMQN/C/PLTYPf XBX(150) 

INTEGER  PLTYP 
EQUIVALENCE  (XBX(l) »XD( 1 ) ) 

EQUIVALENCE  ( XBX<21 ) ,CNC< 1 , 1 )  > 

EQUIVALENCE  ( XBX (61 ) , CRTM( 1 » 1 ) ) 

DIMENSION  XD( 20) ,CNC<2,20) ,CRTM<2»20> 

DATA  M0D/4H  X  / 

1  CONTINUE 

CALL  TRACE(0,8,o) 

LP-6 
IS  =  6 
IR  =  0 

OBTAIN  DATA 

CALL  BEGPR(MOD) 

CALL  FRCL(1002,AM,IS,IR> 

CALL  FRCL(1003,TB0IL,IS»IR) 

CALL  FRCL ( 1 004, DENL, IS , IR) 

IF ( DENL  -  1.)  10.10,20 
.0  CALL  PAGER(6) 

WRITE ( A » 100) 

DENL=1 .01 
!0  CONTINUE 

CALL  FRCL ( 1021 ,DLB» IS, IR) 

CALL  FRCL( 1025, TCRIT. IS. IR) 

CALL  FRCL ( 1031 , SURT , IS , IR ) 

CALL  FRCL(2021»DS»IS»IR> 

CALL  FRCL ( 2023. TWAT , IS » IR ) 

CALL  FRCL(2039,X,IS,IR) 

CALL  FRCL(2040, Y> IS. IR ) 

CALL  FRCL  <2041 v  Z» IS? IR) 

CALL  FRCL ( 2044, DW, IS, IR ) 

CALL  FRCL ( 2045, WW» IS »IR) 

CALL  FRCL  (20  47,  US,  IS  1*1  R) 

CALL  FRCL ( 2052, XN, IS, IR) 

CALL  FRCL ( 4002 ,SP AMT , IS, IR ) 

CALL  ROUTINE  SOLUB  TO  FIND  SOLUBILITY  OF  CHEMICAL  AT  THE 
WATER  TEMPERATURE 

SOLUB  CALLS  DATA  OF  FIELD  NUMBERS  1026,1028,  AND1029 

CALL  SOLUB (TWAT ,CSAT,IS,IR> 

CSAT=CSAT/100. 

CALCULATE  DIFFUSION  COEFF  OF  CHEMICAL  IN  WATER 


CALL  CDIFWt AM, DLB, TWAT, TCRIT, TBOIL.DIFW) 

<<ALL  FR^L??043?il^wf IS* IR) 

CALL  IRCL(3012»ITX,IS,IR) 

IF ( ITX.GE . 1 )  CALL  FRCL(2031,XMX,IS,IR> 
CALL  EPRNT(MOD> IS.IR, IL) 

IF(IL.EQ.l)  GO  TO  99 
IF ( II »EQ.2)  GO  TO  1 


K 
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CALL  SINK 

CALL  SINKi (SURTfDWt US »SPAHT»DENL* XN»DS» TIME » BIST f AREAf PLENf TMSPR) 
CALL  SINK2(DIFWf US f PLENf AREAf CSATfSP AMT f DWf DISRT  r D X STM ) 

CALL  SINK3(HWf DWfX> Y»Z *USf BIST t  TIME f DISRT? DISTMfXNf AREAf PLENtCONCf 
1CLRTM» IFLAG ) 


UPBATE  BATA  BASE 


CALL  OUTPR(MOD) 

CALL  FSV(4032fTIME? 4) 

CALL  FSV(4033»BIST»4) 

CALL  FSV( 4036? DISRT ?4) 

CALL  FSV(4037?DISTM?4) 

CALL  FSV(4038?AREA?4> 

CALL  FSV(4039?PLEN?4) 

CALL  FSV(4040? TMSPR?4> 

CALL  FSVI4041 ? CLRTM  *4) 

IF (CONC.GT .DENL)  C0NC=DENL 
CALL  FSV(4042fC0NC?4> 
CMGL-CONCf 1000000.0 
CPPM=CMGL/BENL 
CALL  PAGER(2) 

WRITE(LP»52)  CPPM? CMGL 
IFdFLAG.NE.l)  GO  TO  75 
CALL  PAGER(4) 

WRITE(6?50) 

CALL  PAGERU) 

WRITE<LPf51> 

CALL  FSV<2039?X?6) 

75  CONTINUE 

CALL  ENBPR(MOB) 

IF < ITX . EQ . 0 )  GO  TO  99 


CALCULATE  BATA  FOR  MAX  CONCENTRATIONS  AT  RIVER  BOTTOM  ANB  SURFACE 
VS  DISTANCE  DOWNSTREAM 


CALL  PAGER(O) 

CALL  PAGER<9) 

WRITEU?305 
WRITE ( 6  ? 31 ) 

WRITE(6? 40) 

WRITE ( 6?  41 ) 

Y=0.0 

2-0.0 

XMN=DIST+PLEN+d0.*2.54*12.) 


SET  MAX  DIST  TO  5  TIMES  MIN  ALLOWED  IF  USER  SUPPLIES  UNREASONABLE 
INPUT 


IF(XMX.LE.XMN)  XMX=5.*XMN 
BX= ( XMX-XMN ) /19 . 

DO  90  11=1 ?2 
DO  80  1=1 »20 
JJJJd 

XD< I )=XMN+ ( (FLOAT (JJJJ)-1»)*DX) 

CALL  SINK3(WW?DW?  XDd ) ?Y?Z? US? BIST? TIME? DISRT ?DISTH?XN?AREA? PLEN? 
1CNC( Ilf  I ) ? CRTM( II? I >  ? IFLAG) 

IFtCNCdl? D.GT.BENL)  CNC( II»I)=BENL 
XBIS=XD(I)/(2. 54*12. ) 

XD< I )=XB ( I ) /100. 

CONC=CNC ( II  *  I ) 11000000 . 

CNCdlf  I)=CONC/DENL 
TMS=CRTM( II f I >/60 . 

THR=CRTM(IIf  D/3600. 

CALL  PAGER ( 1 ) 

WRITE(LP? 70)  XD<I) » XDIS.CONC. CNCdlf  I)  »TMSfTHR 
80  CONTINUE 


T°  ” 

CALL  PAGER (9) 
WRITE(6*30) 
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WRITE< 6,32) 

URITE(6,40) 

WRITE<  6 ,41 > 

90  fflm 

30  FORMAT  </12X» 42HTABLE  OF  MAXIMUM  CONCENTRATION  VS  DISTANCE) 

31  FORMAT<20X»26HAT  WATER  SURFACE  -  MODEL  X//) 

32  F0RMAT(20X,25HAT  WATER  BOTTOM  -  MODEL  X//) 

40  FORMAT <3X,8HDISTANCEf4X»8HBISTANCEf6Xf4HC0NCf8Xf4HC0NC,6X»8HCLR  TI 
1ME,4X,8HCLR  TIME) 

41  FORMAT*  6X,3H(M) ,8X»4H(FT)  ,5X,10H(MG/LITE.R) ,5X,5H(PPM) »6X»&H(MINS) » 
17X,5H(HRS)//) 

50  FORMAT </40H  NOTE-USER  INPUT  FOR  X  WAS  UNREASONABLE./  1Xf43HIT  WAS 
♦CHANGED  AS  NOTED  IN  THE  HACS  MANUAL./) 

51  F0RMAT(1Xf19HTHE  NEW  X  VALUE  IS-) 

52  FORMAT (/1Xf35HTHIS  CONCENTRATION  IS  EQUIVALENT  T0fG10.4f1Xf7HPPM  A 
1NDfG10.4f1Xf?HMG/LITER. ) 

70  F0RMAT(2XfG10.4f2XfG10.4f2XfG10.4f2XfG1O.4f2XfG10.4f2XfG10.4) 

JOO  FORMAT </70H  WARNING  -  THE  CHEMICAL  WHICH  HAS  BEEN  DISCHARGED  HAS  A 

*  LIQUID  DENSITY/68H  SO  CLOSE  TO  WATER  THAT  IT  MAY  OR  MAY  NOT  SINK. 

*  FOR  MODEL  Xf  IT  WILL/50H  BE  ASSUMED  THAT  IT  HAS  A  DENSITY  OF  1,01 

*  GM/CM**//) 

99  CONTINUE 

CALL  TRACE* 1 f8f6) 

END 

SUBROUTINE  SINK1 (SURT f DUfUSfRF'AMT fDENL fXNfDS fTIME fDIST f AREAfPLENf 
*TMSPR ) 

THIS  SUBROUTINE  CALCULATES  THE  TIME  TO  SINKf  DISTANCE  TRAVELED 
DOWNSTREAM  BEFORE  REACHING  RIVER  BOTTOM, AREA  OF  RIVERBED  COVERED, 
LENGTH  OF  CHEMICAL  POOL  ON  RIVERBED,  AND  TIME  FOR  POOL  TO  SPREAD 
TO  ITS  MAXIMUM  EXTENT  FOR  A  HEAVIER-THAN-WATER  ,  SLIGHTLY  SOLUBLE 
CHEMICAL  WITH  A  BOILING  POINT  GREATER  THAN  THE  AMBIENT 
TEMFERATURE  SPILLED  INTO  A  NON-TIDAL  RIVER. 


*****inputs***** 

SURT  *  INTERFACIAL  TENSION  OF  SPILLED  CHEMICAL 
DW  =  DEPTH  OF  RIVER 

US  =  MEAN  STREAM  VELOCITY 

SPAMT=  AMOUNT  OF  CHEMICAL  SPILLED 
DENL  =  DENSITY  OF  LIQUID  SPILLED 
XN  =  MANNING  ROUGHNESS  FACTOR  FOR  RIVER 
DS  =  DISTANCE  FROM  SURFACE  WHERE  RELEASE  TAKES  PLACE 
DS=0.0  AT  SURFACE,  DS=DW  AT  BOTTOM 


NE/CM 


CM/SEC 

GMS 

GM/CM3 

NON-DIM 


*****outputs***** 

TIME  =  TIME  FOR  CHEMICAL  TO  SINK  TO  RIVERBED  SECS 

DIS7  =  DISTANCE  CHEMICAL  TRAVELS  DOWNSTREAM  BEFORE 

REACHING  RIVERBED  CMS 

AREA  *  AREA  OF  RIVERBED  COVERED  BY  CHEMICAL  CM**2 

PLEN  *  LENGTH  OF  CHEMICAL  POOL  ON  RIVERBED  CM 

THSPR=  TIME  FOR  POOL  TO  SPREAD  TO  ITS  MAXIMUM  EXTENT  SECS 


GRAV  = 
l*RW  = 


tmtOTHER  PARAMETERS***** 

CRITICAL  WEBER  NUMBER  AT  WHICH  THE  LIQUID 
BREAKS  UP.  <8>WC)10) 

DRAG  COEFFICIENT  DURING  THE  DECENT  OF  THE 
DROP  IN  WATER. 

EFFECTIVE  GRAVITY  (G*(DENL/DENW-1 . ) ) 
GRAVITATIONAL  ACCELERATION 
PRANDTT  NUMBER  FOR  WATER. 


CM/SEC2 

CM/SEC2 


C******************************* **************************************** 

C  Pl=3. 141592654 
A*1 . 778 
GR=980. 


s 


nnnnnnnnnnnnnnnnnonnn  ooo  ooo 


WC=10. 

CD  =  0 . 4 
DENW-1 .0 

CALCULATE  TIME  TO  SINK  AND  DISTANCE  TRAVELED 

BELRQ=DENL-DENW 
GEFF=GR*(DENL/DENW~1 .) 

.i'-A*(l.-DEL)**1.5)/(l.+A))> 
R0=SQRT<<3./8.)*(WCtCD/F**2)t<SURT/<GRtDELRQ>>) 
U0=F*SQRT<<8./3.)*<GEFF/CD)*R0> 

TIME=(DW-DS)/UO 
DIST=TIMEIUS 

CALCULATE  AREA»LENGTH *  AND  SPREAD  TIME  OF  POOL 

GRAV=GR*(1 ,-BENU/DENL) 

V0L=SPANT/DENL 

E=  (l./12.)*<  1<>4**<3. 113173-8. 571E-2/XN)) 

FD=US/SQRT (GRAVIDU) 

CRITH=0.9783*DW*(FD**:2.8> 

CRITR=0.5704*SQRT(V0LVDW)/FD**1.4 
CRITA=PI*CRITR*t2 

CRITT=(0.2504/FD**2.8)*SQRT<V0L/<GRAV*DU*DW>> 
UC=(8./7.)*<E/DW>**<l./7.) 

UGHFC-1 4 152HSQRT (GRAVtCRITH) 

USHF=(3./7.>*USt(E/DW)#*(l./7.> 
fF(CRITH.GT.E)  GO  TO  3 
RAD=SQRT(VOL/(E*PI>) 

PLEN=2.*RAD 
AREA=PI*RAD*<2 

TMSPR=RAB**2/<(1.14**2)*SQRT(GRAV*V0L>> 

RETURN 

3  AREA-VOL/E 
HC=CRITH/BW 
HF=E/DM 

UBAR=US*(HC**<8./7.)-HF**<8./7,))/<HC"HF) 

V=UBAR/UC 
ALFAF=AREA/CRITA 

evoOtsess?1-5 

4  T0W=T0W+DT0W 
Z=<1.+V*T0W)**1.5 
RHS=(6./V)*(Z**(4./3.)-Z)+Z 
IF<RHS.LT.AL)  GO  TO  4 
TM3PR=CRimTQU*2.*CRITR/UC 
PLEN=2.*CRITR*(l.*VfT0W) 

RETURN 
END 

SUBROUTINE  SINK2(DIFW»US?PLEN» AREA»CSAT » SPAMT »DU»DISRT »DISTM) 

utmiimmmmimmmmumimuutmmuumtmutmt 

THIS  ROUTINE*  USING  THE  LENGTH  AND  AREA  OF  THE  CHEMICAl  POOL 
FROM  ROUTINE  SINK1  CALCULATES  THE  DISSOLUTION  RATE  OF  THE 
SPILL  POOL  INTO  WATER  AND  THE  TIME  IT  TAKES  ALL  THE  CHEMICAL 
TO  DISSOLVE, 


CtmiNPUTSm** 

DIFW  =  DIFFUSION  COEFFICIENT  OF  LIQUID  IN  WATER 

US  =  MEAN  STREAM  VELOCITY 

PLEN  =  LENGTH  OF  CHEMICAL  POOL  ON  RIVERBED 

tlft :  !5EWE.?TO8fREmS8»rY.ra§8'- 

SPAMTs  AMOUNT  OF  CHEMICAL  SPILLED 
DW  *  DEPTH  OF  RIVER 

**»t«OUTPUTS***t* 


CM2/SEC 

CM/SEC 

CM 

CM**2 


DISRT=  AVERAGE  DISSOLUTION  RATE  OF  CHEMICAL  POOL 


GM/SEC 
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DISTM=  TIHE  FOR  ALL  CHEMICAL  TO  DISSOLVE 


*****  OTHER  PARAMETERS  ***** 

S  =  SHAPE  FACTOR-DEPENDS  ON  THE  SHAPE  OF  THE  LIQUID 
POOL-MEAN  VALUE  OF  SEVERAL  STANDARD  GEOMETRICAL 
SHAPES=1 .076 

SC  =  SCHMIDT  NUMBER*KINEMATIC  VISCOSITY  OF  WATER/ 

DIFFUSIVITY  OF  LIQUID  IN  MATER 
REL  =  REYNOLDS  NUMBER  FOR  THE  STREAM  FLOW  BASED  ON 
POOL  LENGTH.  AND  MEAN  STREAM  VELOCITY. 

***t**t****t**t*t*|****|**)|(**f  *********************  ******************** 

DATA  DENU.VISKU.S/1. 0.0. 01 .1,076/ 

CALCULATE  DISSOLUTION  RATE  OF  LIQUID  POOL 

SC=VISKW/DIFW 

REL=US*PLEN/VISKW 

U=AREA/PLEN 

DISRT=S*0.0343*DENW*CSAT*DIFW*W*(SC**(11 ,/27 . ) ) *(REL**(7./9. ) ) 
1*((PLEN/DW )**(!./?, ) ) 

DISTM=SPAMT/DISRT 

RETURN 

IASrOUTINE  SINK3(WW»DM»X.Y»Z.US»DIST .TIME.DISRT.  DISTM.XN.AREA.PLEN 
l.CONC.CLRTM. IFLAG) 

****************************************************»:****************** 

THIS  SUBROUTINE  GIVES  THE  DOWN  STREAM  CONCENTRATION 
OF  A  CHEMICAL  DISSOLVING  SLOWLY  INTO  THE  WATER 
FROM  A  LIQUID  POOL  ON  THE  RIVER  BED.  THE  DISPEFJSION 


CALCULATIONS  ARE  PERFORMED  BY  ASSUMING  A  LINE 
SOURCE  AT  THE  DOWNSTREAM  EDGE  OF  THE  LIQUID  PC 


TIME  = 
D1SRT 
DISTM 
XN 

AREA 

PLEN 


***** INPUTS***** 

WIDTH  OF  RIVER 
DEPTH  OF  RIVER 

DOWNSTREAM  DISTANCE  FROM  SPILL  SITE  AT  WHICH 

DISTANcfe  FR^MIDST^AM^hS^^SRcENTRATION  DESIRED 
DEPTH  IN  RIVER  WHERE  CONCENTRATION  IS  DESIRED 
MEAN  STREAM  VELOCITY 

REACHING  TRAVELS  DDWNSTREAM  BEFORE 

TIME  FOR  CHEMICAL  TO  SINK  TO  RIVERBED 
AVERAGE  DISSOLUTION  RATE  OF  CHEMICAL  POOL 

mwmjBft'tttM  nmi* 

AREA  OF  RIVERBED  COVERED  BY  CHEMICAL 
LENGTH  OF  CHEMICAL  POOL  ON  RIVERBED 

*****OUTPUTS*<*** 


CMS 

CMS 

CMS 

CM/SEC 

CMS 

SECS 

GM/SEC 

SECS 

NON-DIM 

CH**2 

CM 


CONC  *  CONCENTRATION  OF  CHEMICAL  AT  DOWNSTREAM 
POINT  SPECIFIED 

CLRTM*  TIME  AFTER  SPILL  AT  WHICH  POLLUTANTS 

WILL  HAVE  PASSED  DOWNSTREAM  POINT  SPECIFIED 
IFLAG*  FLAG  INDICATING  WHETHER  X  DISTANCE  INPUT  WAS 
RETURNED  MODIFIED  OR  UNCHANOED.  IFLAG=0  MEANS 
IT  WAS  UNCHANGED.  IFLAG*1  MEANS  THE  DISTANCE 
INPUT  WAS  BEHIND  OR  WITHIN  THE  SPILL  POOL  AND 
THE  DISTANCE  WAS  CHANGED  TO  X*DIST+PLEN+X 

*********************************************************** 

CALCULATE  DISPERSION  COEFFICIENTS  FOR  NON  TIDAL  RIVER 

F'IB3. 141592654 
DENW-1 .0 
W*AREA/PLEN 


GH/CM3 


NON-DIM 

************ 


COUUU  UOU  OUU  uuu 


RH=WW*DU/<2.*DW+WW) 

USTAR=6.7305*XH*US/RH**(l./4.) 

FZ=0.0<S7*USTAR  *RH 
EX=0 . 1*EZ 

IF(WW/DU-100. )  10,5,5 
5  EY=0.1*EZ 
(30  TO  15 

30  EY=0,23*USTAR:»RH 
15  X0=X-(DIST+PLt:N) 

IF<XD«LE»0,0)  IFLAG=1 
JF( IFLAG.EQ.  1 )  XD*X 
IFUFLAG.EQ.l  >  X=XD+DIST+PLEN 

ABOVE  MANIPULATION  PREVENTS  UNREASONABLE  X  DISTANCE  INPUT 

DETERMINE  WHETHER  NEAR-  OR  FAR-FIELD  CONCENTRATION  MODEL  IS  USED 

XCRIT*( (WW/W >**2. >*<US*DW/EZ)*DU 
IF (XD-XCRIT)  20,20,25 

CALCULATE  WfiTER  CONCENTRATION  USING  NEAR-STREAM  MODEL 

20  SZ=SGRT(4.*XD*EZ/US) 

SY=SQRT<4,*XD*EY/US> 

CMAX=8^?M/{'2.*SQRT(PI*UStXD*EZ)) 

B=W/2. 

ESP=ERF ( ( Y- WW+B)/SY)-ERF ( ( Y-UH-B)/SY)+ERF ( ( Y+WW+F)/SY)-ERF ( ( Y+WW-B 
1)/SY) 

A=(<DW-Z)/SZ>**2 
AA=  ( (Z+DU) /;3Z) »*2 
C1=CMAX#(EXP(-A)+EXP(-AA) ) 

C2=ERF ( (Y+B )/SY)-ERF ( ( Y-B)/SY)+ESP 

C0NC=C1*C2 

GO  TO  30 

CALCULATE  WATER  CONCENTRATION  USING  FAR-STREAM  MODEL 

25  DOTM=DISRT/W 

C0NC=0ISRT/ (WW*DW*US) 

CALCULATE  TIME  AT  WHICH  ALL  CHEMICAL  GOES  BY  SPECIFIED  POINT  XYZ 


30  CLRTM=TIMEfDISTM+(XD/US> 
-END  OF  FILE- 
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6.  CYBERNET  USE 


Given  the  HACS/UIM  source  program  file,  and  the  external  data  files  used  by 
HACS,  the  execution  of  HACS  is  obtained  by  issuing  the  appropriate  commands 
after  logging  onto  the  Cybernet  system.  Authorization  and  access 
procedures  for  use  are  provided  by  the  National  Response  Center. 

Execution  of  HACS  requires  the  process  of  compiling  the  source  program 
file(s),  loading  these  programs  together  with  system  utilities  and  library 
routines,  then  executing  the  resulting  overlay  load  module  file.  On 
Cybernet,  these  procedures  are  carried  out  as  separate  steps  (during 
development)  to  prepare  the  load  module  file,  and  the  instructions  to 
access  this  file  are  stored  in  a  separate  file  (procedure).  These 
instructions  are: 

ATTACH, UIMABS . 

ATTACH , TAPE  9*PCKP  RP . 

GET, TAPE10=HACST10 . 

ATTACH , TAPE 1 1 =FLDTXT . 

ATTACH , TAPE 12=SCNTXT . 

GET , TAPE 1 3=MODDIR . 

UIMABS. 

These  instructions  are  stored  in  a  procedure  file  named  UIMRUN,  and  the 
only  user  entry  required  (after  log-on)  is  to  type  -UIMRUN. 

The  procedure  establishes  the  required  linkages  between  the  internal  HACS 
file  references  and  the  external  files  cataloged  on  Cybernet.  The  current 
external  files  accessed  on  Cybernet  are: 


PCKPRP 

HACST10 

FLDTXT 

SCNTXT 

MODDIR 


chemical  properties  file 
default  file 

data  item  explanatory  messages 
scenario  descriptions 
model  descriptions 


The  file  UIMABS  contains  the  HACS/UIM  program  code  load  modules  in  overlay 
form.  Files  UIMABS,  PCKPRP,  FLDTXT,  and  SCNTXT  are  direct  access  files; 
HACST10  and  MODDIR  are  indirect  access  files. 

The  statements  ATTACH  and  GET  also  establish  correspondence  (e.g.,  via 
TAPE9"PCKPRP)  from  the  internal  HACS/UIM  file  reference  numbers  9,  10,  11, 
12  and  13  to  the  appropriate  external  files. 


7.  ASSOCIATED  PROGRAMS 


During  the  development  of  the  HACS/UIM,  a  number  of  associated  programs 
were  developed  and  are  briefly  described  in  this  section  together  with 
their  listings.  These  programs  are  grouped  into  four  classifications: 

7.1  Chemical  Property  File  Manipulation, 

7.2  Message  File  Creation, 

7.3  Message  File  Display,  and 

7.4  Utilities. 

The  property  file  manipulation  programs  include  the  conversion  from  the 
prior  fixed  length  format  used  on  both  Cybernet  and  the  CDC  3300  to  the 
variable  length  format  containing  both  model  and  scenario  codes  used  on 
Cybernet  with  the  UIM.  Additional  programs  relating  directly  to  UIM  use  in 
this  section  include  property  file  data  editing  and  conversions  between 
variable  length  format  and  a  variable  logical  record  length  format  packed 
into  a  fixed  physical  record  length  format.  Finally,  this  section  includes 
three  additional  programs  used  to  obtain  analyses  of  property  file 
content:  an  index  of  chemical  recognition  codes  by  hazard  assessment 
model;  an  index  of  chemical  recognition  codes  by  hazard  assessment  path 
codes;  and,  data  gap  identification. 

Sections  7.2  and  7.3  contain  the  programs  used  to  build,  then  display, 
respectively,  the  message  text  files  for  data  fields,  scenarios  and 
assessment  models.  The  master  programs  for  file  building  and  display 
functions  were  first  created  for  the  field  text  file,  then  modified  as 
necessary  for  the  scenario  and  model  messages.  It  was  considered  likely 
that  over  time  changes  or  refinements  in  explanations  for  the  data  fields 
would  be  desired,  and  these  programs  include  capabilities  for  file 
maintenance.  The  creation  of  the  scenario  and  model  descriptions  was 
considered  less  susceptible  to  change  (and  they  are  also  smaller)  so  file 
maintenance  capabilities  were  not  included. 

Two  additional  programs  are  included  in  Section  7.4  as  utilities.  The  first 
is  a  very  generalized  set  of  individual,  and  related,  data  coding  and 
uncoding  utility  routines  which  were  developed  for  use  in  compacting  file 
structures  such  as  the  HACS  physical  property  file.  These  routines  are 
very  generalized,  and  only  a  sub-set  is  used  within  HACS  and  related 
property  file  programs.  The  second  program  in  Section  7.4  is  a  straight¬ 
forward  utility  used  during  terminal  entry  of  program  code  and  message  text 
to  provide  a  translation  of  tab  key  entries. 
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7.1 


Chemical  Property  File  Manipulation 
7.1,1  Model  and  Scenario  Coding 


Program  CMPRS,  listed  on  the  following  pages,  is  used  to  create  a  modified 
version  of  the  property  file  in  which  model  and  scenario  codes  are  appended 
to  each  chemical  data  record,  provision  for  missing  chemical  data  items  in 
the  record  is  deleted,  and  a  file  of  variable  length  records  is  created. 

The  program  requires  the  use  of  the  data  compression  utility  routines  given 
in  Section  7.4.1. 

A  fixed  record  length  version  of  the  property  file  is  read  on  input,  and  the 
file  header  (elements  unchanged)  is  copied  to  output.  Next  a  loop  is 
entered  to  read  each  individual  chemical  data  record.  The  original  model 
codes  in  the  hazard  assessment  path  code  from  the  file  are  compared  to  a 
list  of  code  letters  in  the  program,  and  a  code  is  set  for  each  model  in  the 
sequence  determined  by  the  internal  list.  The  resulting  codes  are  then 
packed  for  output  into  a  single  word.  Note  that  this  translation  produces 
a  completely  uniform  specification  of  hazard  assessment  model  codes  for 
all  900  chemicals. 

After  a  verification  of  the  model  letter  coding,  the  model  letter  codes 
established  from  the  input  file  are  then  used  with  specific  logic  in  the 
program  to  define  all  hazard  assessment  scenario  codes  applicable  for  the 
particular  chemical.  These  codes  are  created  and  then  packed  into  a  single 
code  word  for  output  with  the  chemical  record.  A  verification  step 
(uncoding  and  compare)  is  also  included  to  test  the  validity  of  the  coded 
output . 

Finally  a  third  coding  procedure  is  performed  to  omit  all  chemical  data 
items  which  are  missing  (formerly  stored  as  a  value  of  0.0).  The  chemical 
data  item  status  codes  (0  =  missing,  2  =  estimate,  3  *  exact)  are  packed 
into  a  five  word  array  for  output,  and  the  spaces  formerly  allocated  for 
missing  items  are  then  deleted.  The  final  coded  variable  length  chemical 
data  record  is  then  written  to  the  output  file  using  the  statement  BUFFER 
OUT  (to  obtain  the  desired  variable  length  characteristic  on  Cybernet). 

The  program  produces  a  printed  audit  of  the  conversion/compaction  process 
at  the  user  terminal. 
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81/09/18.  09.31.28. 

PROGRAM  SAVPCK 

PROGRAM  CMPRS (OUTPUT fTAPE6=0UTPUT.TAPE9fTAPE10) 

DIMENSION  FREF(84)  ?  IPTH(  16)  f MFLG (29) f YNAM(5) f YPTH(8)  r  YVAL(74  > 
OINTEGER  BUFF (17) fFCMfFLNfFNBfFNEfFNMfFNXfFSNfHDR(6) fOREC(84) f 

1  OTP. PTLSK30) fSCLST(28>  fSCQD.SFOI fSF02fSF03fSF04fSF05f 

2  SF06fSF07fSF08fSF09fSF10fSF11fSF12fSF13fSF14.SF15fSF16f 

3  SF17fSF18fSF19fSF20fSF21fSF22fSF23fSF24fSF2‘5fSF26fSF27f 

4  SF28 » SFLG  ( 28 ) » TCOD  ( 5 ) » YCOD  r  YT  YF'(  74 ) 

OEQUIVALENCE  (FREF ( 1 ) fOREC( 1 ) ) » <HBR< 1 ) fOREC( 1 ) ) f ( IBI.NKfPTLST (30) ) f 


1 

2 

OEQUIVALENCE 

1 

2 

3 

4 

5 

6 
7 

©EQUIVALENCE 

1 

2 

3 

4 

5 

6 

7 

8 
9 


(MCOD 
(YCOD 
(MSUB 
(MSWE 
(MSWT 
( MSWM 
(MSNQ 


(SF01 
( SF04 
(SF07 
(SF10 
(SF13 
(SF16 
(SF19 
(SF22 
(SF25 
( SF28 


OR£C( 7) ) r (SC0Df0REC(8) ) » (TCOIK  1) » 0REC(9> ) . 
YVAL ( 1 ) ) f ( YNAM( 1 ) . OREC  <  2) ) 
MFLG(2>)f(MSUCfMFLG(3>>f<MSWDfMFLG<4>)f 
HFLG(5) ) . (MSWF  »MFLG(6) ) f (MSWHfMFLG<8) ) f 
MFLG (9) ) . (MSUK . MFLG( 1 1 ) )  f (MSWLfMFLG( 12) ) . 
MFLG< 13) ) t (MSW0»MFLG(15) ) . (MSWP.MFLG( 16) ) f 
MFLG ( 17) ) f (MSWRfMFLG< 18) ) f  <MSWTfMFLG<20> ) f 
(MSWUf MFLG(21 ) ) » (MSMV»MFLG(22) ) f (MSWX.MFLG(24) > f 
(  MSWYfMfLG(25 ) ) . (MSWZ. MFLG( 26) ) . (MSWII .MFLG(27) >  r 
(MSURRfMFLG(23))f(MSWSSfMFLG<29>) 

SFLG(  1 ) ) « (SF02fSFL6(  2)  > f (SF03fSFLG(  3)). 
SFI.G (  4) ) * (SF05rSFLG(  5) ) . (SF06rSFLG(  6))f 
SFLG  <  7) !  i  (SF08fSFLG(  8) > f (SF09.SFLG(  9)). 
SFLG(10)>f(SF11fSFLG(11>>f(3F12fSFLG(12>>. 
SFLG( 13) ) f(SF14fSFLG(14))f(SF 15 » SFLG ( 15) ) . 
SFLG( 16) ) » ( SF17rSFLG( 17) ) ? (SF18fSFLG( 1 8 ) ) » 
SFLG (19) ) f (SF20fSFLG(20>  > f (SF21 fSFLG(21 ) )  f 
SFLG(22) ) . (SF23fSFLG(23) ) . <SF24fSFLG<24> ) , 
SFLG (25) ) . (SF26.SFLG(26) ) . (SF27.SFLG(27) ) . 
SFLG<28) ) 


DATA  ITP/9/fLP/6/f OTP/10/ 

©DATA  <PTLST(I)fI=1f30)/1HAf1HBf1HCf1HDf1HEf1HFf1HGf1HHf1HIf1HJf 

1  IHKfIHLfIHMfIHNfIHOfIHP. 1HQ.1HRf1HSf1HTf1HU.1HVf1HWf1HX.1HYf 

2  1HZf2HII .2HRRf2HSSf 1H  / 

ODATA  (SCLST ( 1 ) . 1=1 f28)/3HA  B,3HA  Cf5HA  B  Cf5HA  D  Ef7HA  D  F  Gt 

1  9HA  D  E  F  G.3HA  Hf5HA  I  Jf7HA  H  I  Jf5HA  K  Lf7HA  K  M  Nf 

2  9HA  K  L  M  Nf3HA  0f3HA  Pf5HA  P  Qf7HA  P  R  Sf9HA  P  Q  R  Sf 

3  3HA  T f5HA  T  Uf5HA  V  W.9HA  T  U  V  Wf3HA  Xf5HA  X  Yf1HZf2HIIf 

4  2HRRf4HRR  Cf2HSS/ 


C 


C 

C - REMIND  INPUT  PROPERTY  FILE  AND  READ  HEADER  RECORD.  TERMINATE 

C  IF  GET  END  OF  FILE. 


READ(ITP)  HDR 
IF(EOF(ITP>)  220.10 
C 

C - REMIND  OUTPUT  FILE  AND  WRITE  VARIABLE  LENGTH  HEADER  RECORD. 

C  NOTE  THAT  RECORD  IS  WRITTEN  IN  ODD  PARITY  AND  STATUS  TEST  IS 

C  REQUIRED  BEFORE  FURTHER  EXECUTION, 


10  REWIND  OTP 

BUFFER  OUT (OTP f 1 )  (HDR( 1 ) fHDR( 6) ) 
IF(UNIT (OTP) )  20f230f240 


C 

C - INITIALIZE  SUMMARY  TOTALS  FOR  FILE  PROCESSING  COUNTS  OF 

C  CONVERTED  ITEMS  AND  WRITE  OUTPUT  HEADER 


20  FCM=0 
FLN=0 
FNX=0 
FNE=0 
FND=0 
FNM=0 
FSN"0 

WRITE(LPf990) 

l . RETURN  HERE  TO  READ  NEXT  PHYSICAL  PROPERTY  RECORD 

30  READ(ITP)  YTYP t YVAL( 1 ) f YNAM f  YPTHf ( YVAL ( I )  f 1  =  4 f  74 ) 


C 
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CJJJCJCJ  _  LJ  UO  LJ  UVOO  O  CJCJLJ  OL'UU 


- TEST  FOR  ENH  OF  FILE  ON  INPUT.  WRITE  EOF  TO  OUTPUT ,  REWIND 

BOTH  TAPES?  WRITE  FILE  CONVERSION  SUMMARY  TOTALS  AND  STOP. 

I F ( EOF ( ITP ) )  40 ? 50 
40  ENDFILE  OTP 
REWIND  OTP 
REWIND  ITP 

WRITE <LP» 1000)  FCM?FLN?FNX?FNE?FND?FNM?FSN 
STOP 


- CHEMICAL  NAME  READ  ON  INPUT  IS  EQUIVALENCED  TO  DESIRED 

LOCATION  IN  OUTPUT  BUFFER.  PREPARE  TO  CODE  MODEL  LETTERS 
BY  FIRST  UNPACKING  PATH  CODES  IN  AS  FORMAT  TO  A4  FORMAT. 
INCREMENT  COUNT  OF  CHEMICAL  RECORDS  AND  MOVE  CHEMICAL 
RECOGNITION  CODE  TO  OUTPUT  BUFFER. 

50  FCM=FCM+1 
OREC ! 1 ) =YCOB 

DECODE' 30 ? IOIOjYPTH'  IPTH 


- L00P  ON  ALL  NON-BLANK  MODEL  CODES  IN  ARRAY  IPTH?  LOOK  EACH  UP 

IN  MASTER  LIST  PTLST.  IF  MATCH  TO  ELEMENT  PTLST(I)?  SET 
INDICATOR  MFLG(I)  TO  1?  OTHERWISE  LEAVE  INITIAL  VALUE  MFLG(I) 
OF  ZERO  UNCHANGED.  WRITE  ERROR  MESSAGE  IF  ANY  NON-BLANK 
UNRECOGNIZABLE  MODEL  CODES  ARE  FOUND  ON  INPUT. 

DO  60  1  =  1 ?  29 
60  MFLG ( I )=0 
DO  SO  1=1 ? 16 
TTMP=IPTH(I) 

IF ( ITMP . EQ . IBLNK)  GO  TO  80 
DO  70  J=1 *29 

IF ( ITMP . NE . PTLST ( J ) )  GO  TO  70 
MFLGU>  =  1 
GO  TO  80 
70  CONTINUE 

WRITE- LP? 1030)  ITMP 
STOP 

80  COM T f HUE 


-SETTINGS  OF  ARRAY  ELEMENT  MFLG(I)  ARE  NOW  0  IF  MODEL  I  NOT 
PRESENT?  1  IF  PRESENT.  PACK  INTO  SINGLE  CODE  WORD  MCOD  FOR 
OUTPUT. 


- READ  EACH  SETTING  OF  PACKED  CODE  WORD  MCOD?  COMPARE  TO 

MFLG  FOR  VERIFICATION  AND  MOVE  UP  TO  10  PATH  CODE  LETTERS 
INTO  PRINT  BUFFER  FOR  DISPLAY. 

K=0 

DO  90  1=1 ?29 
ITMP=IT3T(MC0D?I) 

IF ( ITMP.EQ.MFLG(I) )  GO  TO  85 

WRITE<LP? 1050)  I 

STOP 

85  IF  <  ITMF'.EQ.O)  GO  TO  90 
IF(K.GE.IO)  GO  TO  90 
K=K+3 

BUFF ( K ) =PTLST  < I ) 

90  CONTINUE 

92  IF (K.GE.10)  GO  TO  94 
K=K  +  1 

BUFF(K) -IBLNK 
GO  TO  92 


- USE  SETTINGS  IN  ARRAY  MFLG  TO  IDENTIFY  SCENARIOS.  SET  VALUES 

IN  ARRAY  SFLG  TO  1  IF  SCENARIO  I  IS  PRESENT?  0  OTHERWISE. 
START  WITH  MODELS  RR  AND  C  FOR  SCENARIOS  RR?  RR-C. 

94  DO  100  1=1? 28 
100  SFLG ( I ) =0 

IF (MSWRR.EQ.O)  GO  TO  120 
IF (MSWC.EQ.O)  GO  TO  110 
SF  27=1 
GO  TO  170 
110  SF26=1 
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- SCENARIOS  FOR  MODELS  Of  1,  Ilf  SS 

120  SF13=MSU0 
SF24=MSWZ 
SF25=MSWII 
SF28=MSWSS 


- SCENARIOS  A-Bf  A-C  AND  A-B-C 

5F01=MSWB 

SF02=MSWC 

SF03=(M5WB+HSWC)/2 


- SCENARIOS  A-D-Ef  A-D-F-G  AND  A-D-E-F-G 

SF04=MSW£ 

SF  05=MSWF 

SF06= ( HSWE+HSWF ) /2 


- SCENARIOS  A-Hf  A-I-J  AND  A-H-I-J 

SF07=MSWH 

SF08=MSWI 

SF09=(MSWH+MSWI )/2 


- SCENARIOS  A-K-Lf  A-K-M-N  AND  A-K-L-M-N 

SF10=MSWL 

SF11=MSWM 

SF 12= ( MSWL+HSWM ) /2 


- SCENARIOS  A-Pf  A-P-Qf  A-P-R-S  AND  A-P-Q-R-S 

IF ( MSWP . EG . 0)  GO  TO  130 

SF15=MSWQ 

SF16=MSWR 

ITMP=MSWG+MSWR 

SF17=ITMP/2 

IF(ITMP.EI.O)  SF14=1 


. SCENARIOS  A-Tf  A-T-Uf  A-V-U  AND  A-T-U-V-W.  IF  MODELS  U  AND  V 

ARE  GIVEN  WITHOUT  Tf  ONLY  SCENARIO  A-V-W  IS  OBTAINED.  IF  T 
AND  V  ARE  GIVEN  WITHOUT  Uf  ONLY  A-T  IS  OBTAINED  SINCE  A-T-V-U 
IS  INVALID  AS  A  COMPLETE  SCENARIO. 

130  IF(MSWT.EG.O)  GO  TO  150 
IF(MSWU.EG.l)  GO  TO  140 
SF 18=1 
GO  TO  160 
140  SF19=1 
SF21=MSUV 
150  SF20=MSWV 


- SCENARIOS  A-X  AND  A-X-Y 

160  IF ( MSWX.EO. 0)  GO  TO  170 
SF23=MSWY 

IF< MSWY . EO. 0 )  SF22=1 


. . SETTINGS  OF  ARRAY  ELEMENT  SFLG(I)  NOW  DEFINE  PRESENCE  (1)  OR 

ABSENCE  (0)  OF  SCENARIO  I.  PACK  INTO  SINGLE  CODE  WORD  SCOD 
FOR  OUTPUT. 

170  CALL  INIT(SC0Df28.1f 1) 

CALL  PACK(SFLGfSCOD) 


■ . READ  EACH  SETTING  OF  PACKED  CODE  WORD  SCOD  AND  COMPARE  TO 

SFLG  FOR  VERIFICATION.  MOVE  SCENARIO  CODE  LETTERS  INTO  PRINT 
BUFFER  FOR  DISPLAY.  NOTE  THAT  A  LIMIT  OF  7  SCENARIOS  CAN  BE 
DISPLAYED. 

DO  180  1=1 f 28 
ITNP=ITST (SCODf I > 

IF ( ITMP  »EQ»SFLG( I ) )  GO  TO  175 

WRITE (Lrf 10/0)  I 

STOP 

175  IF ( ITMP .EQ .0)  GO  TO  180 
FSN=FSN+1 

IF ( K.GE . 171  GO  TO  1B0 
K=K  +  1 

BUFF(K ' =SCLST ( I ) 


non  cm  non  no  oooo  0000000000 


180  CONTINUE 


. CONVERT  CHEMICAL  DATA  ITEM  STATUS  CODES  READ  ON  INPUT  AS  ONE 

CODE  PER  ELEMENT  OF  ARRAY  YTYP  TO  PACKED  FORMAT  IN  CODE  UORD 
ARRAY  TCOD.  NOTE  THAT  CODE  VALUES  ALLOWED  ARE  0*1 *2*3  WHICH 
PROVIDES  FOR  ADDITION  OF  CHEMICAL  SPECIFIC  DEFAULT  ITEMS  AS 
CODE  1.  THE  CODE  ARRAY  TCOD  CONTAINS  5  WORDS  OF  WHICH  30  BITS 
EACH  ARE  USED.  THE  PACKED  CODES  ARE  EACH  2  BITS  IN  LENGTH  SO 

§E58I8feD!FP^K{88E?sc88»!SfTi8i86UTf^cIEf«u«oS??6I^EK 

WOULD  REQUIRE  ALL  75  CODES  TO  BE  STORED). 

CALL  INIT (TC0D.30.5.2 ) 

DO  190  1=1 .74 

190  CALL  SET (TCOD. I .YTYP( I) ) 


- READ  EACH  SETTING  OF  PACKED  DATA  ITEM  STATUS  CODES  AND 

COMPARE  TO  ORIGINAL  VALUE  IN  YTYP  ARRAY  FOR  VERIFICATION. 
USE  PACKED  CODES  TO  COUNT  DATA  ITEM  TYPES. 

NX=0 

NF=0 

ND=0 

NM=0 

DO  200  1=1.74 
ITMP=ITST (TCOD. I ) 

If (ITMP.EQ,YTYP(I))  GO  TO  195 

WRITE(LP» 1080)  I 

STOP 

195  IF(ITMP.EQ.O)  NM=NM+1 
IF< ITMP.EG. 1 )  ND=ND+1 
IF ( ITMP.EQ.2)  NE=NE+1 
IF(ITMP,EQ.3)  NX=NX+1 
200  CONTINUE 
FNM=FNM+NM 
FND=FND+ND 
FNE=FNE+NE 
FNX=FNX+NX 


. -—MOVE  ALL  NON-MISSING  DATA  ITEM  VALUES  IN  ARRAY  YVAL  TO  ARRAY 

FREF  FOR  OUTPUT.  CODING  ASSUMES  ONE-WORD  FORMAT  FOR  BOTH 
INTEGERS  AND  REAL  VALUES.  SO  THAT  FIRST  DATA  VALUE  IS  MOVED 
INTO  POSITION  14  OF  OUTPUT  RECORD. 

LN=13 

DO  210  1=4.74 

IF( YTYP( I ) . EQ .0 )  GO  TO  210 
LN=LN+1 

FREF(LN)=YVAL< I > 

210  CONTINUE 
FLN=FLN+LN 


- DISPLAY  SUMMARY  OUTPUT  FOR  COMPACTED  RECORD 

WRITE(LP.1090)  YCOD.LN.NX.NE.ND.NM. (BUFF (I) .I=1»K) 


LE.  THEN  RETURN 


NEXT  CHEMICAL'AFTE: 

BUFFER  OUT (OTP. 1 )  (0REC(1 ) .OREC(LN) ) 

IF(UNIT (OTP) )  30.230.240 

C . NON-RECOVERABLE  ERROR  CONDITIONS 

220  WRITE<LP» 1 100) 

STOP 

230  WRITE ( LP. 1110) 

STOP 

240  WRITE(LP» 1120) 

STOP 

C  9900FORMAT  (//75H  SUMMARY  REPORT  ON  SCENARIO  CODING  AND  COMPACTION  OF 
1CHEHICAL  PROPERTY  FILE//44H  COD  LN  NX  NE  ND  NM  HAZARD  ASSESSMENT  M 
200ELS.7X.76HSCENARI0  1  SCENARIO  2  SCENARIO  3  SCENARIO  4  SCENARIO  5 

3  SCENARIO  6  SCENARIO  7/20H  .  »30<1H-) .7(1X.10(1H- 

4))) 

lOOOOFORMAT  (//5X.22HC0NVERTED  FILE  T0TALS5//5X.I5.33H  VARIABLE  LENGTH 
1CHEMICAL  REC0RDS/5X. I5.33H  WORDS  FOR  COMPACTED  FILE  ST0RAGE/5X. 15. 
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225H  EXACT  DATA  VALUES  ST0RED/5X» I5»29H  ESTIMATED  DATA  VALUES  STORE 
3D/5X»I5»27H  DEFAULT  DATA  VALUES  STORED/5X» I5»28H  MISSING  DATA  VALU 
4ES  SKIPPED/5X» I5»22H  SCENARIO  CODES  STORED///) 

1010  FORMAT  (8<2A4,2X>> 

1030  FORMAT  (5X>26H*t**tUNKN0UN  MODEL  CODE  =  »A10> 

1050  FORMAT  C5X>25H**mERR0R  ON  MODEL  CODE  ,I2>13H  VERIFICATION) 

1070  FORMAT  <5X  .28H*m*ERR0R  ON  SCENARIO  CODE  »I2.13H  VERIFICATION) 
1030  FORMAT  < 5X» 26Hm#*ERR0R  ON  STATUS  CODE  »I2*13H  VERIFICATION) 

1090  FORMAT  (lX»A3f5(lXf 12) *1X.10A3»7(1X»A10) ) 

1100  FORMAT  <5X>44H*m*ERR0R  -  HEADER  ON  INPUT  PRECEDED  BY  EOF) 

1110  FORMAT  <5X.21H*m*E0F  ERROR  ON  OTP) 

1120  FORMAT  (5X»24H***«PARITY  ERROR  ON  OTP) 

END 


READY. 
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7.1.2  Variable  to  Fixed  Length  Conversion 


On  Cybernet,  it  was  found  that  variable  length  records  were  written  in 
either  a  variable  length  or  fixed  length  format  depending  on  the  program 
statements  used,  and  the  operating  procedures  used  (e.g.,  PACK).  The 
BUFFER  OUT/BUFFER  IN  statements  currently  used  in  HACS/UIM  provide, 
without  packing  the  chemical  data  file,  the  desired  variable  length 
structure. 


A  brief  review  of  the  standard  Fortran  features  available  on  both  DEC  and 
PRIME  computers  indicated  that  some  difficulty  in  building  similar 
variable  length  file  structures  might  be  encountered  in  conversion,  and 
two  additional  programs  were  created. 

The  first,  PROGRAM  CONV,  is  listed  in  the  following  section,  and  provides 
for  the  conversion  of  a  variable  record  length  file  created  by  PROGRAM 
CMPRS  (refer  to  Section  7.1.1)  to  a  file  in  which  the  variable  length 
records  are  packed  into  fixed  length  physical  records.  Output  is  performed 
by  unformatted  WRITE  statements  instead  of  BUFFER  OUT. 

Subroutine  MVLRC  (refer  to  Section  7.1.3)  provides  for  input  conversion  of 
the  file  created  by  this  program.  Neither  CONV  nor  MVLRC  are  used  by  the 
current  version  of  HACS/UIM  on  Cybernet;  these  are  provided  for  future  use 
on  DEC  or  PRIME  installations  as  may  be  desired. 
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81/09/18.  09.33.47. 

PROGRAM  RGPBTB 

PROGRAM  CHNV < OUTPUT . TAPE6=0UTPUT , T APE9 .  T  AF'El  0 ) 

PROGRAM  CONV  (FOR  CONVERT)  READS  AN  INPUT  CHEMICAL  PROPERTY 

SMeIWH^  w 

BEGINNING  OF  EACH  RECORD.  UNFORMATTED.  FIXED  LENGTH  BINARY 
RECORDS  ARE  WRITTEN  TO  THE  OUTPUT  FILE.  THE  LAST  OUTPUT  FIXED 
LENGTH  RECORD  IS  FILLED  WITH  ZEROES  IF  NECESSARY.  FOR  SUB¬ 
SEQUENT  SEQUENTIAL  INPUT  FROM  THE  FIXED  LENGTH  RECORD  FILE,  THE 
LOGICAL  RECORD  LENGTH  IN  THE  RECORD  IS  REQUIRED  TO  CONTROL 
INPUT  OF  FIXED  LENGTH  RECORDS  TO  RECONSTRUCT  THE  DESIRED 
VARIABLE  LENGTH  LOGICAL  RECORD. 


BLEN 


I 

IREC 


ITP 

J 

LEN 

LP 

OREC 

OTP 


FIXED  LENGTH  OF  OUTPUT  RECORD  BUFFER.  SET  HERE  TO  63 
FOR  CORRESPONDENCE  WITH  MINIMUM  CDC  MASS  STORAGE 
DISK  ALLOCATION 

INDEX  TO  ELEMENTS  OF  VARIABLE  LENGTH  INPUT  RECORD 
BUFFER  FOR  STORAGE  OF  INPUT  VARIABLE  LENGTH  RECORD. 
MAXIMUM  RECORD  LENGTH  (ON  INPUT)  IS  84  WORDS  TO 
TO  BE  STORED  IN  POSITIONS  2  TO  85  OF  IRFC. 

I/O  UNIT  NUMBER  FOR  INPUT  FILE 

INDEX  TO  ELEMENTS  IN  FIXED  LENGTH  OUTPUT  BUFFER. 

CYCLES  BETWEEN  1  AND  BLEN  BY  1. 

ADJUSTED  LENGTH  OF  VARIABLE  LENGTH  INPUT  RECORD  (ONE 
IS  ADDED  TO  ADJUST  FOR  STORAGE  OF  LENGTH  COUNT) 

I/O  UNIT  NUMBER  FOR  PARITY  ERROR  MESSAGE 
OUTPUT  BUFFER.  FIXED  LENGTH  *  BLEN 
I/O  UNIT  NUMBER  FOR  OUTPUT  FILE 


COMMON  VARIABLES  USED  -  NONE 

SUBROUTINES  REQUIRED  -  LENGTH. UNIT 

AUTHOR  -  R.G.  POTTS.  ARTHUR  D.  LITTLE.  INC.. 


BauMnhRn. 


DATE 


TEL.  617-864-5770 
-  16  JANUARY  1981 
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INTEGER  BLEN. OREC. OTP 

DIMENSION  IREC (85). OREC (63) 

EQUIVALENCE  (LEN.IREC(l) ) 

DATA  BLEN/63/.ITP/9/.LP/6/.0TP/10/ 


- INITIALIZE.  REWIND  BOTH  FILES  AND  SET  OUTPUT  BUFFER  POINTER 

TO  EMPTY  VALUE. 

REWIND  ITP 
REWIND  OTP 
J*0 


. RETURN  HERE  TO  READ  EACH  NEW  INPUT  RECORD  UNTIL  EOF  OR  PARITY 

ERROR  IS  ENCOUNTERED.  INPUT  RECORD  IS  READ  INTO  ARRAY  IREC 
FROM  POSITION  2  ON.  TEST  FOR  EOF  OR  PARITY  ERROR  AND  BRANCH 
TO  PROCESS.  OTHERWISE  OBTAIN  LENGTH  OF  INPUT  RECORD.  AND 
STORE  LENGTH  OF  OUTPUT  RECORD  (=INPUT  LENGTH  +  1)  IN  POSITION 

10  BUF^e8FIN^I^.1)  ( IREC(2)  »IREC(85) ) 

IF(UNIT( ITP) )  20.40.60 
20  LEN*LENGTH(ITPH1 


C 

C 


■MOVE  WORDS  1  TO  LEN  FROM  INPUT  ARRAY  IREC  TO  POSITION  IN  OUTPUT 
ARRAY  OREC.  EACH  TIME  DREC  IS  FILLED  TO  CAPACITY  (BLEN).  WRITE 
OUTPUT  RECORD  AND  RE-INITIALIZE  TO  STORE  NEXT  WORD  FROM  IREC 
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IN  FIRST  POSITION  OF  OREC. 

DO  30  1*1, LEN 
J*J+1 

IF(J.LE.BLEN)  00  TO  30 
WRITE(OTP)  OREC 

30  0REC( J)*IREC(I) 

- — UK  MiWRiB  HPB’iKf!. 

REACHED. 

60  TO  10 


. EOF  ON  INPUT  UNIT  HAS  BEEN  REACHED.  FILL  LAST  OUTPUT  BUFFER 

WITH  ZEROES,  THEN  WRITE  OREC  AND  TERMINATE  RUN. 

40  J*J+1 


IF(J.GT.BLEN)  GO  TO  50 
OREC( J)*0 


GO  TO  40 


C 

C 


50  WRITE(OTP)  OREC 
ENDFILE  OTP 


GO  TO  70 


- PARITY  ERROR  CONDITION.  HRITE  ERROR  MESSAGE  AND  TERMINATE  RUN 

n  BHSKtf"*’ 

REMIND  (TP 
STOP 

1000  FORMAT  (47H  ***WPARITY  ERROR  ON  INPUT  TAPE.  JOB  ABORTED.//) 

END 


READY 


7.1.3  Fixed  to  Variable  Length  Conversion 

Referring  Co  Section  7.1.2  for  additional  information,  Subroutine  MVLRC 
listed  on  the  following  pages  can  be  used  to  read  a  blocked  fixed  length 
file  of  chemical  property  data  and  extract  the  desired  variable  length 
chemical  data  record.  Program  TEST  which  precedes  MVLRC  in  the  listing  is 
a  short  test  program  used  to  read  the  data  file,  and  print  selected 
information.  This  program  illustrates  the  method  used  to  read  the  data 
file,  and  can  be  used  as  a  model  for  HACS/UIM  revision  if  the  file  structure 
is  changed  during  conversion.  Subroutine  MVLRC  does  not  currently  appear 
in  the  Cybernet  operating  version  of  HACS/UIM.  Note  that  subroutine  MVLRC 
processes  the  input  file  using  only  unformatted  READ  statements. 
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81/09/18.  09.36.15. 

PROGRAM  RGPMLR 

PROGRAM  TEST(OUTPUT.TAPE6=OUTPUT .TAPE9) 

COMMON/SAVE/IERR. IREC(85) « J 
INTEGER  YCOD 

EQUIVALENCE  ( LEN.IRECd ) ) .  (YC0D?IREC(2) ) 

10  CALL  MVLRC(K) 

WRITE(6»1000)  K.IERR. J.LEN.YCOD 

IF(IERR.EQ.O)  GO  TO  10 

STOP 

1000  FORMAT  (3X.I3.3X. II . 3X. I2.3X.I2.3X. A3> 

END 

SUBROUTINE  HVLRC(K) 

SUBROUTINE  MVLRC  (FOR  HOVE  LOGICAL  RECORD)  READS  A  VARIABLE 
LENGTH  LOGICAL  RECORD  FROM  AN  EXTERNAL  FILE  OF  UNFORMATTED 
(BINARY)  FIXED  LENGTH  RECORDS  CONTAINING  RECORD  LENGTH 
POINTERS.  THIS  ROUTINE  IS  INTENDED  TO  BE  USED  TO  MOVE  THE 
LOGICAL  RECORDS  SEQUENTIALLY  FROM  THE  BEGINNING  OF  THE  FILE 
TO  THE  END  OF  THE  FILE.  EACH  CALL  RETURNS  THE  NEXT  LOGICAL 
RECORD.  STORED  IN  THE  COMMON  BLOCK  SAVE.  PRIOR  TO  THE  FIRST 
USE.  THE  CALLING  PROGRAM  SHOULD  SET  THE  ARGUMENT  K  TO  ZERO. 


BLEN 

I 

IERR 

IREC 

J 


LEN 


OREC 

OTP 


FIXED  LENGTH  OF  EXTERNAL  FILE  RECORDS.  SET  TO  63 
FOR  CORRESPONDENCE  WITH  PROGRAM  USED  TO  CREATE 
THE  FILE. 

INDEX  TO  ELEMENTS  IN  VARIABLE  LENGTH  RECORD  TO  BE 
RETURNED  TO  CALLING  PROGRAM 
END  OF  FILE  STATUS  INDICATOR  RETURNED  TO  CALLING 
PROGRAM,  0  IS  NORMAL  RETURN.  1  INDICATES  END  OF 
FILE.  ON  RETURN  WITH  IERR=1.  THE  CONTENTS  OF  IREC 

areaeforTsto^a§Pof  variaIlPlengthddata‘record.  UP  TO 

A  MAXIMUM  OF  85  WORDS  IN  LENGTH.  LENGTH.  LEN.  IS 
STORED  IN  POSITION  1  ON  RETURN  IF  IERR=0. 

INDEX  TO  ELEMENTS  IN  FIXED  LENGTH  BUFFER.  CYCLES 
BETWEEN  1  AND  BLEN  BY  1.  NOTE  THAT  J  IS  SAVED  IN 
COMMON  AND  INITIALIZATION  IS  FORCED  BY  INITIAL 
CALL  WITH  K=0 . 

NUMERICAL  INDEX  TO  VARIABLE  LENGTH  RECORDS.  ON  INPUT. 
VALUE  GIVES  SEQUENTIAL  NUMBER  OF  RECORD  PETURNED  BY 
LAST  CALL.  ON  OUTPUT.  K  GIVES  NUMBER  OF  RECORD 
RETURNED  BY  CURRENT  CALL. 

TOTAL  LENGTH  OF  VARIABLE  LENGTH  RECORD.  STORE?  ON 
RETURN  IN  FIRST  LOCATION  0*  IREC.  MAY  BE  ZERO  ON 
RETURN  FOP  END  OF  FILE. 

FIXED  LENGTH  RECORD  BUFFER.  LENGTH  =  BI.EN 
I/O  UNIT  NUMBER  FOP  FIXED  LENGTH  RECORD  FILE 


COMMON  VARIABLES  USED  -  IERP > IPEC. J.LEN 

SUBROUTINES  REQUIRED  -  EOF 

AUTHOR  -  R.G.  POTTS.  ARTHUR  D.  LITTLE.  TNC,. 

35/3J3A  ACORN  PARK. 
CAMBRIDGE.  MASS.?  02140 
TEL.  61 ’-864-57?$  EXT.  2813 


DATE  -  16  JANUARY  1981 


C0MM0N/SAVE/IERR.IREC<85) » J 
EQUIVALENCE  (LEN. IREC! 1) ) 

INTEGER  BLEN»OREC( 63) .DTP 

DATA  BLEN/63/. OTP/9/ 
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- FOR  INITIAL  CALL  WITH  K=0,  REWIND  FtXED  LENGTH  RECORD  FILE  AND 

SET  BUFFER  POINTER  TO  FORCE  FIRST  READ. 

IF(K.NE.O)  GO  TO  10 
REWIND  OTP 
J=8LEN 


- INITIALISE  FOR  EACH  NEW  RECORD  TO  BE  RETURNED.  SET  ERROR  FLAG 

IERR  TO  NO  ERROR  VALUE ,  AND  MOVE  K.  TO  NUMBER  OF  RECORD  TO  BE 
RETURNED.  INDEX  J  IS  INCREMENTED  TO  FIRST  POSITION  OF  NEXT 
LOGICAL  RECORD  WHICH  CONTAINS  THE  LENGTH  OF  THAT  RECORD- 
10  IERR=0 
K=K+1 
J=J+1 


- IF  POINTER  J  EXCEEDS  LENGTH  OF  FIXED  LWTH  BUFFER.  READ  NEXT 

BUFFER  AND  RESET  POINTER  TO  FIRST  POSITION.  WPP  TO  EDO  RETURN 
IF  END  OF  FILE  IS  FOUND.  OTHERWISE  SAVE  LENGTH  JF  NEyt  LOGICAL 
RECORD.  NOTE  THAT  ZERO  FILL  IN  LAST  FIXED  LENGTH  BUFFS*  ALSO 
INDICATES  END  OF  FILE  CONDITION. 

IFEJ.LE.BLEN)  GO  TO  30 
READ(uTP)  OREC 
IF<EOF < OTP) )  AO. 20 
20  J=1 

30  LEN=OREC( J) 

IF(LEN.EQ.O)  GO  TO  60 


. MOVE  ELEMENTS  2  TO  LEN  INTO  VARIABLE  LENGTH  RECORD  FIELDS. 

READ  NEW  BUFFER  EACH  TIME  POINTER  J  MOVES  OUT  OF  RANGE  OF 
FIXED  LENGTH  BUFFER.  NOTE  EOF  TEST  IS  USED  Fnp  EACH  READ.  AND 
THAT  THIS  CODE  ASSUMES  LEN  .GE.  2.  RETURN  WHEN  DONE. 

DO  50  1*2, LEN 
J=J+1 

IF( J.LE.BLEN)  GO  TO  50 
READ < OTP)  OREC 
IF <EOF ( OTP ) )  60,40 
40  J=1 

50  IREC(I)=OREC< J) 

RETURN 


60  IERR=1 
RETURN 
END 

READY. 


OF  FILE  RETURN.  SET  IERR  AND  RETURN. 
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7.1.4  CDC  3300  Conversion 


Program  CONV  which  is  listed  on  the  following  pages  has  evolved  as  the 
primary  means  of  transferring  the  chemical  property  data  from  the  CDC  3300 
to  other  computers.  On  the  CDC  3300  the  selective  retrieval  and  display 
program  is  run  with  options  selected  to  output  all  non-missing  data  items 
for  all  chemicals  to  an  output  tape.  The  tape  contains  one  data  item  per 
output  record,  in  the  format  required  for  property  file  updates.  (Refer  to 
documentation  on  the  separate  retrieval  and  update  programs  for  additional 
detailed  information.) 

Program  CONV  reads  the  tape  file  written  on  the  CDC  3300,  and  produces  as 
output  on  the  host  computer  a  file  written  in  binary  format  for  use  with 
HACS.  Functions  performed  by  CONV  include  setting  status  codes,  inserting 
missing  data  values  (0.0)  which  are  not  present  in  the  input  file,  and 
collecting  all  input  records  for  a  single  chemical  into  a  single  output 
record. 

The  output  file  produced  is  formatted  as  a  series  of  fixed  length  binary 
records  (original  HACS  property  file  format). 
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81/09/18.  11.49.46 
PROGRAM  RGPCNV 


PROGRAM  C0NV(0UTPUT»TAPE6=0UTPUT ,TAPE9,TAPE10) 

INTEGER  EST»HDR,QTP,XCnD, YTYP 
REAL  FBLNK, YNAM, YPTH, YVAL 
INTEGER  IBLNK 

INTEGER  I,IBUF,ITAG»ITP? NFLH » NWCOD 

DIMENSION  H0R<6),TBUF(7),YNAM<5),YPTH<8),YTYP(74),YVAL<74) 
EQUIVALENCE  ( IBLNK »FBLNK> f (NWCOD. YVAL(l) ) 

DATA  EST/lHE/f I  TP/9/ r OTP/1 0/. IBLNK/1H  / 

DATA  HDR(6)/4HX246/,HDR(?)/18/,HDR(1 ) /9J.678/ 

DATA  HDR(3)/4HX149/,HDR(4)/19/,HDR(3)/91678/ 


10 

1000 


20 


30 


40 

1010 


50 


60 

70 


1100 


80 

1200 


90 

1300 


100 

1500 


110 


120 

1020 


130 

140 


1030 


HDR 


REWIND  OTP 
URITE(OTP) 

REWIND  ITP 

READdTP, 1000)  NWCOD. NFLD 
FORMAT  (A3. IX. 12) 

IF (EOF ( ITP) )  140,20 
TF(NFLD.NE.l)  GO  TO  120 
YTYP(1)=3 
YTYP(2)=3 
YTYP<3)=3 
DO  30  1=4,74 
YTYP ( I )=0 
YVAL ( I )=0 . 0 
YVAL( 11 )=FBLNK 
YVAL(69)=FBLNK 

READdTP,  1010)  XCOD.NFLD, ITAG , IBUF 
FORMAT  (A3,1X,I2,1X,A1,2X,7A10) 

IF(EOFdTP))  130,50 
IF(XCOD.NE. NWCOD)  GO  TO  t 10 
IF(NFLD.LE.l)  GO  TO  120 
IF (NFLD.GT .74)  GO  TO  120 
IFdTAG.NE. IBLNK)  GO  TO  60 
YTYP(NFLD)=3 
GO  TO  70 

IFdTAG.NE. EST)  GO  TO  120 
YTYP(NFLD)=2 
CONTINUE 

IF(NFLD.EQ,2)  GO  TO  80 
IF(NFLD.EG.3)  GO  TO  90 
IF(NFLD. EQ.lt)  GO  TO  100 
IF(NFLD.EQ. 69 )  GO  TO 
DEC0DE(16, 1100, IBUF) 

FORMAT  (G16.6) 

GO  TO  40 

DEC0DE(40, 1200, IBUF) 

FORMAT  (5A8 ) 

GO  TO  40 

DEC0DE<64, 1300, IBUF) 

FORMAT  (8A8) 

GO  TO  40 

DECODED,  1500,  IBUF)  YVAL  (NFLD) 

FORMAT  ( A8) 

GO  TO  40 
BACKSPACE  ITP 

WRITE ( OTP )  YT YP , YVAL ( 1 ) , YNAM , YPTH , ( YVAL (I ) , 1=4 , 74 ) 
GO  TO  10 
WRITE(6, 1020) 

FORMAT  (28H  CONVERSION  ERROR  OCCURRED.) 

STOP 

gRJTJtgTPlpYTYPfYVALd), YNAM,  YPTH,  (YVALd),  1*4, 74) 

REWIND  OTP 
REWIND  ITP 
WRITE(6,1030) 

FORMAT  (24H  SUCCESSFUL  CONVERSION.) 

STOP 


100 

YVAL(NFLD) 


YNAM 


YPTH 


7.1.5  Recognition  Code/Model  Cross-Reference 


Three  programs,  Sections  7.1.5,  7.1.6  and  7.1.7,  are  all  named  program  GAP, 
and  contain  many  similarities;  each  has  been  adapted  however  to  perform  a 
different  function. 

In  this  section,  the  version  of  program  GAP  is  used  to  read  a  HACS  physical 
property  data  file  and  produce  a  cross-reference  listing  of  chemical 
recognition  codes  which  include  a  particular  assessment  model  letter  in 
the  path  codes  on  the  file.  The  purpose  of  these  programs  was  to  obtain  the 
cross-reference  lists  as  quickly  as  possible.  Since  they  will  be  run  very 
infrequently,  efficiency  of  internal  operations  was  relatively  unimpor¬ 
tant,  and  large  internal  arrays  are  used  to  aggregate  the  required 
information. 

As  each  chemical  record  is  read,  the  hazard  assessment  model  letters 
contained  in  the  path  codes  on  the  file  are  individually  stored  in  an 
array.  A  corresponding  entry  in  a  second  array  is  made  with  the  chemical 
recognition  code.  This  process  continues  until  all  chemical  data  records 
have  been  read.  The  program  currently  allows  a  maximum  of  3000  model 
references  which  is  adequate  for  the  900  chemicals;  however,  this  limit 
will  need  to  be  increased  as  new  chemicals  are  added  to  the  file. 

When  the  input  file  has  been  completely  processed,  a  second  step  is 
initiated.  A  single  model  letter  is  picked  from  the  list  A  -  Z,  II,  RR,  SS, 
and  the  stored  array  of  codes  from  the  property  file  is  searched  for  all 
occurrences  of  that  letter.  For  each  occurrence,  the  corresponding 
chemical  recognition  code  is  moved  to  another  array  for  printing.  The  print 
array  (SVCOD)  is  currently  limited  to  a  maximum  of  900  entries,  corres¬ 
ponding  to  the  number  of  chemicals  which  is  the  maximum  number  of  possible 
entries  in  the  print  array.  This  size  will  also  need  to  be  expanded  as 
additional  chemicals  are  added  to  the  file. 

After  the  stored  code  arrays  have  been  entirely  searched,  the  program 
prints  the  selected  model  letter,  the  number  of  references,  and  the  list  of 
chemical  recognition  codes  (from  the  print  array)  that  reference  that 
model  in  their  path  codes.  Since  the  alphabetic  sequence  of  the  original 
input  file  has  been  preserved,  the  chemical  recognition  codes  are  printed 
alphabetically  within  model  letter  codes. 

The  second  step  process  is  repeated  for  each  different  assessment  model 
letter  code  until  chemical  recognition  codes  for  all  29  models  have  been 
displayed . 
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81/09/18.  11.50.35 
PROGRAM  RGPMOD 


PROGRAM  GAP ( INPUT ,  OUTPUT » T APE6= OUTPUT .TAPE 9 ) 

PROGRAM  TABULATES  CHEMICAL  RECOGNITION  CODES  FOR 
INDIVIDUAL  RATE  MODELS. 


AUTHOR  -  R.G.  POTTS. 


ARTHUR  D.  l.TTTLE,  INC. 
35/T13A  ACORN  PARK. 
CAMBRIDGE.  MASS..  02140 
TEL <  617-864-5770  EXT,  2813 


DATE  -  03  JULY  1980 


DIMENSION  HDR<6),IPTH(16)»PTLST(30)»YNAM(5),YPTH(8),YTYP<?4^ 
DIMENSION  YVAL ( 74 ) 

INTEGER  CLST < 3000), MLST (3000) .SVCOD (900) 

INTEGER  HDR.PTLST .YCOD.YTYP 

EQUIVALENCE  ( YCOD, YVAL < 1 ) ) 

DATA  IBLNK/4H  /.ITP/9/.LP/6/ 


ODATA  (PTLST(I), 1=1,30)/ 


1 

4HA 

.  4HB 

» 4HC 

,4  HD 

,4HE 

» 4HF 

,  4HG 

» 4HH  , 

*J 

4HI 

,4HJ 

»4HK 

» 4HL 

,  4HM 

,  4HN 

,  4HD 

,  4HP  » 

3 

4HQ 

,  4HR 

,4HS 

,4HT 

?  4HU 

» 4HV 

,  4HW 

,  4HX  , 

4 

4HY 

,  4H2 

,4HII 

f4HRR 

,  4HSS 

,4H 

/ 

-REWIND 

TAPE  AND 

READ 

HEADER 

RECORD. 

TERMINATE  IF 

GET  END 

REWIND  ITP 
READ(ITP)  HDR 
IF  ( EOF ( ITP ) ) 5 , 30 


C 

C . —INITIAL  END  OF  FILE  ERROR  CONDITION 

5  WRITE ( LP , 1010 ) 

REWIND  ITP 
STOP 

C - NORMAL  RETURN 


20  CONTINUE 

WRITE(LP» 1070)  M 
DO  74  1=1.29 
MOD=PTLST ( I > 

N=0 

DO  22  J=1,M 

IF (MOD .NE . MLST ( J ) )  GO  TO  22 
N=N  +  1 

IF (N.GT .900)  GO  TO  70 
SVCOD<N)=CLST(J) 

22  CONTINUE 

WRITE < LP , 1080 !  MOD.N 
WRITE(LP,1090)  (SVC0D(K),K=1»N) 
24  CONTINUE 
C 

REWIND  ITP 
STOP 


C 

C . PRINT  REPORT  TITLE  AND  DISPLAY  FII  E  HFADER 

30  CONTINUE 
M  =  0 

WRITE(LP» 1050) 

WRITEILP. 1020)  HDR(5) »HDR<4 > ,HDR(3) »HDR(6) ,HDR<?) »HDR( 1 ) 
C 

C . RETURN  HERE  TO  READ  NEXT  PHYSICAL  PROPERTY  RECORD 

40  READ(ITP)  YTYP. YVAL< 1 ) » YNAM. YPTH, < YVAL ( I ) , 1  =  4 , 74) 

C 

C . TEST  FOR  END  OF  FILE.  STOP  ON  EOF. 

IF (EOF (ITP) )  20,50 
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C- . PROCESS  CHEMICAL  RECORD 

50  CONTINUE 
C 

C . -UNPACK  PATH  CODES  AND  STORE  IN  ARRAY  IPTH 


DECODE(B0»1040» YPTH)  IPTH 
DO  60  1=1 r 16 

IF(IPTH(I) *EQ,IBLNK)  GO  TO  60 
M=M+1 

IF (M.GT >3000)  GO  TO  70 

CLST(M>=YCOD 

MLST (M)  =  IPTHd) 

60  CONTINUE 
GO  TO  40 

70  WRITE(LPf 1060) 

REMIND  ITP 
STOP 


1010  FORMAT  (/5X.46H*****ERR0R  -  UNABLE  TO  READ  MACS  PROPERTY  FILF) 
10200F0RMAT  </10X»21HFILE  OPENED  HAS  ID  =  » A4 »20H»  VERSION  NUMBER  =  > 

1  1 5 r 10H»  DATE  =  »I6/13X»18H BACK-UP  FILE  ID  *  »A4r20H»  VERSION  NU 
2MBER  =  i I5> lOHi  DATE  =  r 16) 

1030  FORMAT  <2X»A3»3X,5A8»3X»8A8> 

1040  FORMAT  <8<2A4,2X)) 

1050  FORMAT  </5X>43HLIST  OF  CHEMICAL  RECOGNITION  CODES  BY  MODEL//) 

1060  FORMAT  </5X*28#*m*ERR0R  -  BUFFER  OVERFLOW) 

1070  FORMAT  ( /5X»35HT0TAL  NUMBER  OF  MODEL  REFERENCES  -  .15) 

10800F0RMAT  ( //5X * 6HM0DEL  *A2*5H  HAS  »I3»26H  REFERENCES*  BY  CHEMICALS: 

1  /) 

1090  FORMAT  (/14X.10A6) 

END 

READY, 
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7.1.6  Recognition  Code/Assessment  Path  Cross-Reference 

The  version  of  program  GAP  which  follows  performs  an  almost  identical 
function  to  the  version  of  program  GAP  in  Section  7.1.5  except  that  the 
hazard  assessment  path  codes  contained  on  the  input  chemical  properties 
file  are  evaluated  in  aggregate,  not  as  single  model  letters.  This 
identifies  each  different  hazard  assessment  path  code  contained  on  the 
property  file,  and  lists  for  each  the  chemical  recognition  codes  of  all 
chemicals  giving  the  particular  path  code.  Note  that  the  hazard  assessment 
scenarios  are  sub-sets  of  these  path  codes,  and  the  information  produced  by 
this  program  was  used  to  validate  the  rules  of  scenario  formation  developed 
for  HACS/UIM. 

The  program  reads  each  chemical  data  record  and  compares  the  path  codes  to 
a  stored  table  of  previously  read  path  codes.  If  the  path  codes  are  found 
in  the  table,  the  chemical  recognition  code  is  stored  in  an  array.  A 
corresponding  pointer  is  also  set  linking  the  recognition  code  to  the  table 
entry.  If  the  path  codes  are  not  found  in  the  table,  they  are  appended  to 
the  end  of  the  table  as  a  new  entry.  The  recognition  code  and  linking 
pointer  are  stored  as  before.  The  program  currently  limits  the  size  of 
this  table  to  100  different  hazard  assessment  path  codes;  this  should  allow 
some  expansion  beyond  the  current  900  chemicals  before  an  increase  is 
required.  However,  the  arrays  of  saved  recognition  codes  and  linking 
pointers  are  limited  to  900  entries  and  expansion  will  be  required  as  new 
chemicals  are  added  to  the  file. 

The  second  portion  of  the  program  simply  loops  through  the  stored  table  of 
different  path  codes.  The  table  index  is  used  to  link  to  the  stored  array 
of  chemical  recognition  codes  to  identify  each  chemical  listing  the 
indexed  path  code,  and  a  printed  display  is  produced. 

Since  the  path  code  table  is  generated  as  the  chemicals  are  processed, 
alphabetically  by  chemical  recognition  code,  and  since  table  entries  are 
made  using  exact  character  matches,  the  resulting  output  report  has  the 
following  characteristics : 

•  The  path  codes  are  listed  in  sequence  according  to  the  first 
appearance  on  the  property  file. 

•  Within  each  path  code,  chemicals  are  listed  alphabetically  by 
chemical  recognition  code. 

•  Logically  equivalent  path  codes  may  appear  more  than  once  in  the 
display  containing  the  same  model  letter  codes  arranged  in 
different  sequence. 
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81/09/18.  11. 51.  >3. 

PROGRAM  RGPPTH 

PROGRAM  GAP ( INPUT » OUTPUT , TAPE6=0UTPUT , TAPE9 ) 

PROGRAM  TO  TABULATE  UNIQUE  PATH  CODES  ON  FILE. 

AUTHOR  -  R.6.  POTTS.  ARTHUR  D.  LITTLE.  INC. 

35/318A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 

DATE  -  03  JULY  1980 

ODIHENSION  HDR<  6) » IPTH( 16) » IREQ<74 ), LI ST (14,74) »l.REF(30) »PBUF(74 ) , 
1  PTLST  <  30) ,YNAM<5) , YPTH(fl) , YTYP(74) » YVAL(74) 

DIMENSION  NEST (74) .NEXT (74) , NGAP(74> »NT0T(74) 

INTEGER  HDR.PBUF, PTLST, YCOD.YTYP 
INTEGER  SVC0D(900) ,  SVPTH(900) ,PRC0D(900) 

EQUIVALENCE  ( YCOD,  YVAI.(  1 ) ) 

INTEGER  CNT (100) ,T0T 
DIMENSION  TAB( 100,8) 

DATA  IBLNK/4H  /, ITP/9/.LP/6/ 

ODATA  (PTLST < I ) , 1  =  1 ,30)/ 


1 

4HA 

•  4HB 

>  4HC 

,4HD 

,4HE 

,  4HF 

,4HG 

,4HH 

2 

4HI 

,  4HJ 

,4HK 

•  4HL 

,4HM 

,  4HN 

,  4H0 

,4HP 

3 

4HQ 

,  4HR 

,  4HS 

•  4HT 

»4HU 

,  4HV 

,  4HU 

,4HX 

4 

4HY 

,  4H7 

,4HTI 

,  4HRR 

,  4HSS 

,4H 

/ 

_ 

-REWIND 

TAPE  AND 

READ 

HEADER 

RECORD. 

TERMINATE  IF 

GET 

REWIND  ITP 
READ(ITP)  HDR 
IF  (E0F( ITP) >5,30 
C 

C - INITIAL  END  OF  FILE  ERROR  CONDITION 

5  WRITE(LP.IOIO) 

STOP 

C - NORMAL  RETURN 

20  CONTINUE 
T0T=0 

WRITE(LP,1090)  N 

1090  FORMAT  (/5X,14HF1LE  CONTAINS  ,I2,21H  DIFFERENT  PATH  CODES/) 
DO  21  1=1, N 
TOT=TOT+CNT (I) 

WRITE (LP, 1070)  CNT(I) ,(TAB(I ,J),J=1,8) 

1070  FORMAT  (//5X,I3,25H  OCCURRENCES  OF  PATH’  ,8A8/> 

L=0 

DO  22  J=1 ,900 

IF(SVPTH( J) .NE.I)  GO  TO  22 
L=L+1 

PRCOD(L)=SVCOD< J) 

22  CONTINUE 

WRITE(LP, 1100)  (PRCOD(K) ,K=1 ,L> 

1100  FORMAT  (/10X.10A6) 

21  CONTINUE 
WRITE(LP» 1080)  TOT 

1080  FORMAT  (5X.5H . /5X.I5) 

C 

REWIND  ITP 
STOP 
C 

C . PRINT  REPORT  TITLE  AND  DISPLAY  FI!  E  HEADER 

30  CONTINUE 

WRITE(LP,1050) 

M=0 

N=0 
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00  25  1*1  *  100 
25  CNT ( I )  =0 

WRITE <LPf 1020)  HDR<5)fHDR(4)fHDR<3) fHDR!6) fHDR<2) fHDR<1) 

C 

C . RETURN  HERE  TO  READ  NEXT  PHYSICAL  PROPERTY  RECORD 

40  READ(ITP)  YTYPf YVAL< i ) • YNAM  f YPTHf ( YVAL (I) *I=4»74) 

C 

C . —TEST  FOR  END  OF  FILE.  STOP  ON  EOF. 

IF(EOF(ITP> )  20f50 
C 

C - PROCESS  CHEMICAL  RECORD 

50  CONTINUE 
C 

C . —COUNT  IF  PATH  ALREADY  IN  TABLE »  OTHERWISE  ADD  TO  TABLE. 

IF(N.EQ.O)  GO  TO  80 
DO  70  1=1 »N 
DO  AO  J=1  f8 

IF<YPTH(J) .NE.TAB(IfJ))  GO  TO  70 
60  CONTINUE 
M=M+1 

SVCOD(M)=YCOD 
SVPTH(M)=I 
CNT ( I >  *CNT  < I )  +  1 
GO  TO  40 
70  CONTINUE 
80  N=N+1 

IF (N.GT . 100)  GO  TO  100 
DO  90  J=1f8 
90  TAB(NfJ)=YPTH(J) 

CNT (N)=CNT (N)+l 
M*M+1 

SVCOD(M)=YC0D 
SVPTH(M,=N 
GO  TO  40 

100  WRITE<LPf1060) 

STOP 

C 

1010  FORHAT  </5X»46H*m*ERR0R  -  UNABLE  TO  READ  HACS  PROPERTY  FILE) 
10200FQRMAT  </10Xf21HFILE  OPENED  HAS  ID  =  fA4f20Hf  VERSION  NUMBER  *  f 
1  1 5 f  1  OH f  DATE  =  f I6/13X f J8HBACK-IJP  FILE  ID  -•  fA4.20Hf  VERSION  NU 
2MBER  =  f I5f IOHf  DATE  =  fI6) 

1030  FORMAT  (2XfA3f3Xf5A8f3Xf8A8) 

1040  FORMAT  (8(2A4f2X)) 

1050  FORMAT  <//5Xf26HTABLE  OF  UNIQUE  PATH  CODES//) 

1060  FORMAT  ( /5Xf 1 4HTABLE  OVERFLOW) 

END 

READY. 
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7.1.7  Data  Gap  Identification 

The  version  of  program  GAP  which  follows  is  the  master  chemical  property 
file  data  gap  identification  program  which  correlates  data  values  missing 
on  the  property  file  with  actual  HACS  model  input  requirements. 

Matrix  elements  are  set  in  the  program  to  define  the  correspondence  between 
HACS  model  inputs  and  individual  property  data  items.  Note  that  the 
program  cannot  distinguish  among  different  conditions  which  may  occur 
within  a  rate  model,  that  is,  property  input  required  under  some  conditions 
but  not  others. 

The  following  program  listing  gives  detailed  documentation.  Note  that  the 
program  can  also  be  modified  (refer  to  comments  in  the  listing)  to  perform 
selective  screening  functions  and  these  steps  were  used  to  develop  the 
overall  data  gap  analyses. 
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81/09/18.  11.52.38. 
PROGRAM  RGPGAP 


PROGRAM  GAP < INPUT .OUTPUT ,TAPE6=0UTPUT, TAPE9) 


PROGRAM  GAP  READS  AS  TNPUT  A  HACS  PHYSICAL  PROPERTY  DATA 
FILE  (TAPE?)  AND  PRODUCES  AS  OUTPUT  A  PRINTED  REPORT 
IDENTIFYING  ALL  DATA  GAPS  BY  PROPERTY  ITEM  FIELD  NUMBER. 

A  DATA  GAP  IS  DEFINED  AS  A  PROPERTY  ITEM  WHICH  MAY  BE  REQUIRED 
BY  AT  LEAST  ONE  OF  THE  MODELS  IN  THE  PATH  CODE  ON  THE  FILE 
AND  WHICH  HAS  A  CURRENT  STATUS  TAG  OF  MISSING.  CORRESPONDENCE 
BETWEEN  THE  CURRENT  HACS  MODELS  AND  PROPERTY  DATA  ITEMS  TS 
GIVEN  BY  THE  ELEMENTS  IN  THE  DATA  ARRAY  LIST.  ANY  MODEL 
CHANGES  OR  REVISIONS  RELATED  TO  THE  USE  OF  PROPERTY  DATA  MAY 
ALSO  REQUIRE  UPDATES  TO  THIS  ARRAY. 

THE  ARRAY  LREF  CONTROLS  THE  INDEXING  FROM  AN  ALPHABETIC  MODEL 
CODE.  OBTAINED  FROM  THE  INPUT  PROPERTY  FILE  IN  THF  APRAY  IPTH. 
TO  THE  APPROPRIATE  ENTRY  IN  THE  LIST  OF  REQUIRED  ITEMS.  LIST. 
THE  PROGRAM  CAN  BE  ADAPTED  FOR  SELECTIVE  DATA  GAP  SCREENING 
BY  MODIFYING  DATA  VALUES  IN  THE  ARRAY  LREF.  A  VALUF  IN  LREF 
OF  0  INDICATES  THE  CORRESPONDING  MODEL  EITHER  DOES  NOT  REQUIRE 
PROPERTY  DATA.  OR  HAS  BEEN  OMITTED  FROM  THE  SCREEN. 

THE  PROGRAM  MAY  ALSO  BE  ADAPTED  FOR  SELECTIVE  SCREENING 
BY  SPECIFIC  PROPERTY  ITEMS  BY  EITHER  MODIFYING  THE  ELEMENTS 
OF  THE  ARRAY  LIST  WHICH  ARE  SET  TO  It  OR  BY  ALLOWING  ONLY 
SELECTED  VALUES  OF  IREQ  TO  BE  SET  TO  1  IN  THE  DO  LOOP  ON  J 
TO  STATEMENT  90.  FOR  EXAMPLE.  THIS  COULD  BE  USED  TO  ISOLATE 
ALL  ACTUAL  DATA  GAPS  FOR  A  SINGLE  TEMPERATURE  FUNCTION. 

AFTER  PRINTING  IDENTIFICATION  OF  ALL  DATA  GAPS  FOR  EACH 
CHEMICAL  ON  THE  FILE.  THE  PROGRAM  PRINTS  SUMMARY  COUNTS 
OF  THE  NUMBER  OF  PROPERTY  ITEMS  ACTUALLY  USED  BY  THE  MODELS, 
BROKEN  DOWN  BY  STATUS  CODE.  NOTE  THAT  THESE  SUMMARY  COUNTS 
ARE  NOT  THE  SAME  AS  GIVEN  BY  THE  PROPERTY  RETRIEVAL  PROGRAM 
(WHICH  REPORTS  ON  ALL  ITEMS  STORED,  WHETHER  OR  NOT  USED), 

HDR  =  HEADER,  FIRST  RECORD  ON  PROPERTY  FILE,  IDENTIFIES 
CURRENT  AND  PREVIOUS  FILE  VERSIONS 
I  =  LOOP  INDEX 

IBLNK  =  DATA  WORD  SET  TO  BLANKS  USED  TO  SKIP  FMPTY  MODEL 
CODES  IN  ASSESSMENT  PATH  DATA 

IPTH  =  PATH  CODES  FOR  SINGLE  CHEMICAL,  UP  TO  16  MODEL  CODES 
INTERPRETED  FROM  INPUT  ARRAY  YPTH  TO  GIVE  SINGLE 
ALPHABETIC  MODEL  CODE  IN  EACH  WORD 
IREQ  =  CONTROLLING  ARRAY  FOR  DATA  GAP  SCREEN  FOR  SINGLE 

CHEMICAL.  ELEMENT  I  IS  INITIALIZED  TO  ZERO,  THEN 
SET  TO  1  IF  ANY  MODEL  IN  PATH  CODE  LIST  FOR  THE 
CHEMICAL  USES  PROPERTY  ITEM  I  AS  INPUT. 

ITP  =  FORTRAN  UNIT  REFERENCE  NUMBER  FOR  INPUT  PROPERTY 
TAPE  FILE 

J  =  LOOP  INDEX 

K  =  INDEX  POINTER  TO  LINE  OF  ARRAY  LIST  FOR  SINGLE 

MODEL  CODE  IN  PATH  LIST,  OR  ZERO  IF  MODEL  DOES 
NOT  REQUIRE  PROPERTY  DATA 

LGAP  =  SEQUENCE  COUNT  OF  DATA  GAPS  FOUND  FOR  SINGLE  CHEMICAL 
LIST  =  MASTER  REFERENCE  LIST  ESTABLISHING  EACH  UNIQUE  SET 

OF  PROPERTY  DATA  ITEMS,  CURRENTLY  CONTAINS  14  SUB¬ 
LISTS  OF  74  ELEMENTS  EACH.  SOME  SUB-LISTS  ARE  USED 
MORE  THAN  ONCE  (FOR  DIFFERENT  MODELS).  ELEMENT  I 
ON  SUB-LIST  IS  SET  TO  1  IF  MODEL  CORRESPONDING  TO 
SUB-LIST  USES  PROPERTY  ITEM  I,  OR  IS  ZERO  OTHERWISE. 

LP  =  FORTRAN  UNIT  REFERENCE  NUMBER  FOR  PRINTER  _  _ _ 

LREF  =  ARRAY  CONTAINING  SUB-LIST  INDEX  NUMBER  (TO  ARRAY  LIST) 
FOR  EACH  ALPHABETIC  MODEL  CODE,  IN  POSITION 
CORRESPONDING  TO  LOCATION  OF  MODEL  CODE  IN  PTLST 
NEST  *  NUMBER  OF  REQUIRED  PROPERTY  ITEMS  ON  DATA  FILE  FOR 
WHICH  THE  CURRENT  VALUE  IS  AN  ESTIMATE 
NEXT  =  NUMBER  OF  REQUIRED  PROPERTY  ITEMS  ON  DATA  FILE  FOR 
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WHICH  THE  CURRENT  VALUE  IS  EXACT 

NGAP  =  NUMBER  OF  REQUIRED  PROPERTY  ITEMS  ON  DATA  FILE  FOR 
WHICH  THE  CURRENT  VALUE  IS  MISSING 

NTOT  =  TOTAL  NUMBER  OF  ITEMS  ON  PROPERTY  FILE  ACTUALLY 
USED  BY  HACS  MODEL. 

PBUF  =  PRINT  BUFFER,  ELEMENTS  1  TO  LGAP  CONTAIN  PROPERTY 
ITEM  INDEX  NUMBER  OF  EACH  DATA  GAP  FOR  SINGLE 
CHEMICAL 

PTLST  =  LIST  OF  ALL  ALPHABETIC  MODEL  LETTER  CODES  WHICH  CAN 
APPEAR  IN  PATH  CODE  FOR  CHEMICAL 

YCOD  =  CHEMICAL  RECOGNITION  CODE  READ  FROM  PROPERTY  FILE 

YN AM  s  CHEMICAL  NAME 

YPTH  =  ARRAY  OF  MODEL  CODES  READ  ON  INPUT  FOR  PATH  CODE  FOR 
PARTICULAR  CHEMICAL.  CONVERSION  FROM  CDC  3300 
PRODUCES  STORAGE  OF  MORE  THAN  ONE  CODE  PER  WORD  OF 
ARRAY.  CONVERSION  IN  THIS  PROGRAM  PRODUCES  USFABLE 
LIST  OF  CODES  IN  ARRAY  IPTH. 

YTYP  =  ARRAY  OF  STATUS  CODES  FOR  EACH  ITEM  (1  TO  74)  STORED 
ON  PROPERTY  FILE  FOR  SINGLE  CHEMICAL  (0=MISSING, 
2=ESTIHATE ,  3=EXACT> 

YVAL  =  ARRAY  USED  FOR  STORAGE  OF  NUMERIC  VALUES  OF  PROPERTY 
ITEMS.  REQUIRED  HERE  ONLY  TO  READ  ENTIRE  CHEMICAL 
DATA  RECORD 


COMMON  VARIABLES  USED  -  NONE 

SUBROUTINES  REQUIRED  -  NONE 

AUTHOR  -  R.G.  POTTS.  ARTHUR  D.  LITTLE.  INC. 

35/318A  ACORN  PARK. 
CAMBRIDGE.  MASS..  02140 
TEL,  617-864-5770  EXT.  2813 


DATE 


03  JULY  1980 


C 

C 


ODIMENSION  HDR(6) . IPTH( 16) » IREQ(74) ,LIST(14 .74) »LREF(30) »PBUF(74) » 
1  PTLST (30) »YNAM(5) .YPTH (8) .YTYP (74) .YVAL (74) 

DIMENSION  NEST ( 74 ) .NEXT ( 74 ) . NGAP ( 74 ) .NTOT (74 ) 

INTEGER  HDR. PBUF .PTLST .YCOD .YTYP 

EQUIVALENCE  ( YCOD. YVAL( 1 ) ) 


DATA  IBLNK/4H 


/.ITP/9/.LP/6/ 


ODATA 

1 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

ODATA 

1 

ODATA 

1 

ODATA 

1 

DATA 

ODATA 

1 


(LIST ( 1 , I ) » 1=1 


(LIST(2» I ) 
(LIST(3. 1 ) 
(LIST (4.1) 
(LISK5.I) 
(LIST(6 . 1 ) 
(LIST (7.1 ) 
(LIST(8» I) 
(LIST(9» I ) 
(LIST (10. I 

(LISTdl.I 

(LIST (12.1 

<LIST(13.I 
(LIST (14.1 


.1  =  1 
.1  =  1 
.1=1 
.1=1 
.1  =  1 
.1  =  1 
.1  =  1 
.1  =  1 
).I  = 

)»I  = 

).I  = 

).I  = 
>.I= 


.  74 ) /3*0,2*1« 6*0. 5*1.14*0. 4*1. 8*0. 3*1 .2*0. 6*1. 
0.1.19*0/ 

.  74 )/3*0. 1.38*0. 3*1. 24*0. 4*1.0/ 

.74 )/3*0.i.56*0. 1.2*0. 1.10*0/ 

.745/4*0.1.6*0.5*1.2*0.4*1,32*0.1.19*0/ 

,745/3*0. 2*1, 6*0. 5*1, 26*0. 3*1 ,17*0, 1.9*0, 1,0/ 

,745/4*0,1,6*0,5*1,18*0,1,7*0,3*1,9*0,1,19*0/ 

,74 5/3*0, 2*1. 0.1, 4*0, 5*1, 22*0, 1,0, 5*1, 29*0/ 

,745/3*0,2*1,6*0,5*1,44*0,1,2*0,1,10*0/ 

,745/3*0,2*1,0,1,4*0,5*1,58*0/ 

1,745/3*0, 2*1, 0,1, 4*0, 5*1 .26*0, 3*1 ,15*0, 1,2*0. 

1,10*0/ 

1,745/3*0, 2*1, 0,1, 4*0, 5*1, 2*0, 4*1, 12*0, 1,0, 1,0. 
1,0,2*1,32*0/ 

1,745/3*0, 2*1, 6*0, 5*1, 2*0, 4*1, 8*0, 4*1, 2*0,1, 

5*0 , 3* l » 9*0 , 1 » 5*0 , 1 ,13*0/ 
1,745/3*0,1,7*0,5*1,44*0,1,2*0,1,10*0/ 
1,745/3*0,2*1,0,1,4*0,5*1,20*0,1,0,1,0,2*1, 
32*0/ 


ODATA 

(LREF (15,1= 

1,305/1, 

2,3, 4,5, 

4,3,5, 

6, 3, 7, 5, 0,8,0 

,9,5,10,3, 

1 

11 

,5,12,13 

,14,6*0/ 

ODATA 

(PTLST ( I ) , I 

=  1  ,305/ 

1 

4HA 

»4HB 

,4HC 

,4HD 

»4HE 

,  4HF  , 4HG 

,4HH  , 

2 

4HI 

,4H  J 

»4HK 

,  4HL 

,  4HM 

, 4HN  ,4H0 

»4HP  , 

3 

4HQ 

»4HR 

,4HS 

.  4HT 

» 4HU 

,4HV  , 4HW 

,4HX  , 

4 

4HY 

,4HZ 

»4HII 

,4HRR 

,  4HSS 

,4H  / 
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. INITIALIZE  SUMMARY  COUNTS 

DO  1  1=1.74 
NEST  ( I  )=0 
NEXTd  )=0 
NGAP( I )=0 
1  NTOT (I  )=0 

. REMIND  TAPE  AND  READ  HEADER  RECORD.  TERMINATE  IF  GET  END  FILE. 

REWIND  ITP 
READ(ITP)  HDR 
IF  (EOF < ITP) )5»30 

- INITIAL  END  OF  FILE  ERROR  CONDITION 

5  WRITE(LP» 1010) 

. NORMAL  RETURN 

20  CONTINUE 

. PRINT  SUMMARY  COUNTS  OF  REQUIRED  DATA  ITEMS 

WRITE(LP»1090) 

DO  25  1=4.74 

WRITE(LP.llOO)  I .NGAP (I ) »NEST(I ) .NEXT(I) »NT0T(I ) 

NGAP ( 1 ) =NGAP  *  1 ) 4NGAP ( I ) 

NEST ( 1  )*NEST ( 1 )+NEST ( I ) 

NEXT  <  1 )  =NEXT  ( 1 )  (-NEXT  ( I ) 

25  NTOT ( 1  )=NT0T  < 1 )+NT0T ( I > 

URITE(LPf 1110)  NGAP ( l ) .NEST( 1 > .NEXT ( 1 ) »NT0T( 1 ) 

REWIND  ITP 
STOP 

. -PRINT  REPORT  TITLE  AND  DISPLAY  FILE  HEADER 

30  CONTINUE 

WRITE(LP»1120) 

WRITE(LP»1020)  HBR<5).HBR(4),HBR(3).HDR(6).HDR(2>.HDR(1> 

. RETURN  HERE  TO  READ  NEXT  PHYSICAL  PROPERTY  RECORD 

40  READ(ITP)  YTYP»YVAL(1)»YNAM.YPTH.(YVAL(I>.I=4.74> 

. TEST  FOR  END  OF  FILE.  STOP  ON  EOF. 

IF(E0F (ITP) )  20.50 

. —PROCESS  CHEMICAL  RECORD 

50  CONTINUE 

. UNPACK  PATH  CODES  AND  STORE  IN  ARRAY  IPTH 

DECODE (80. 1040. YPTH)  IPTH 

. INITIALIZE  ARRAY  IREQ 

DO  60  1=1.74 
60  IREQ( I )=0 

. LOOP  THROUGH  EACH  MODEL  CODE  IN  PATH  READ  FOR  SINGLE  CHEMICAL. 

SKIP  ALL  BLANK  MODEL  CODES  IN  PATH. 

DO  100  1*1.16 

IF ( IPTH ( I ) .EQ. IBLNK)  GO  TO  100 

. FOR  EACH  NON-BLANK  MODEL  CODE  READ.  USE  LIST  OF  VALID  CODES 

TO  TRANSLATE  FROM  LETTER  CODE  TO  NUMERIC  SUB-LIST  INDEX  K. 

K*0 

DO  70  J*i»29 

IF(IPTH(I).NE.PTLST(J))  GO  TO  70 

. FOUND  MATCH.  CROSS-REFERENCE  FROM  MODEL  LETTER  CODE  TO 

SUB-LIST  OF  REQUIRED  PROPERTY  DATA. 

K-LREF(J) 

GO  TO  80 
70  CONTINUE 

. NOTE  -  K*0  HERE  IF  MODEL  DOES  NOT  USE  PROPERTY  DATA  OR  IF 

MODEL  CODE  IS  NOT  DEFINED  ON  LIST.  SKIP  IF  NO  DATA  IS  REQUIRED 
FOR  THIS  MODEL. 

80  IF(K.EQ.O)  GO  TO  100 
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. SET  EACH  ELEMENT  OF  IREQ  ARRAY  TO  1  FOR  EACH  REQUIRED  DATA 

ITEM  FOR  THIS  MODEL  CODE, 

DO  90  J=1 ,74 

IF (LIST(K, J) .GT.O)  IREQ(J>=1 
90  CONTINUE 


. CONTINUE  100P  FOR  EACH  MODEL  CODE  IN  PATH 

100  CONTINUE 


■  . FOR  EACH  REQUIRED  DATA  ITEM.  CHECK  STATUS  CODE.  STORE  INDEX 

OF  MISSING  ITEMS  IN  ARRAY  PBUF  FOR  PRINTING. 

LGAP=0 

DO  110  1=1 »74 

IF( IREQ(I) .EQ.O)  GO  TO  110 

- COUNT  TOTAL  NUMBER  OF  DATA  ITEMS  ACTUALLY  REQUIRED. 

NTOTd  )*NTOT ( I )+l 

■  . BRANCH  ON  STATUS  CODE  OF  ITEM.  INCREMENT  COUNTS  OF  EXACT  AND 

ESTIMATED  ITEMS  THEN  CONTINUE  IF  VALUE  IS  NOT  MISSING. 
IF(YTYP(I)  .EQ.3)  NEXTd)=NEXT(I)U 
IF(  YTYPd  >  ,EQ . 2 )  NEST ( I  )=NESTd  )  +  l 
IF(  YTYPd ) . GT.O)  GO  TO  110 

. —ITEM  IS  DATA  GAP.  STORE  ITEM  INDEX  FOR  PRINT  DISPLAY 

NGAP(I)=NGAP(I>+1 
i»GAP=LGAP+l 
PBUF(LGAP)=I 
110  CONTINUE 


. SKIP  IF  NO  DATA  GAPS.  OTHERWISE  DISPLAY  CHEMICAL  ID  FIRST. 

PBUF  DISPLAY  IS  FRAGMENTED  TO  AVOID  UNNECESSARY  BLANK  LINES 
IN  OUTPUT  OF  VARIABLE  LENGTH  DATA  WHICH  MAY  POSSIBLY  EXCFED 
LENGTH  OF  ONE  OR  TWO  PRINT  LINES.  AFTER  DISPLAY.  CYCLE 
BACK  FOR  NEXT  CHEMICAL  OR  EOF. 

IF(LGAP.EQ.O)  GO  TO  40 
WRITE(LP.1030)  YCOD.YNAM.YPTH 

120  IF (LGAP.GT . 30 )  GO  TO  130 

WRITEILP.1070)  LGAP. (PBUF (I) .1*1 .LGAP) 

GO  TO  40 

130  WRITE(LP. 1070)  LGAP. (PBUFd > .1=1 .30) 

IF(LGAP,GT ,60)  GO  TO  140 
WRITE(LP.  1080)  (PBUFd),  1=31. LGAP) 

GO  TO  40 

140  WRITE(LP.  1080)  (PBUFd ),  1  =  31 .60) 

WRITE(LP, 1080)  (PBUF(I) . 1=61, LGAP) 

GO  TO  40 
C 

1010  FORMAT  ( /5X , 46H44* If ERROR  -  UNABLE  TO  READ  MACS  PROPERTY  FILE) 
10200F0RMAT  (/10X.21HFILE  OPENED  HAS  ID  =  .A4.20H,  VERSION  NUMBER  . 

1  15.1  OH .  DATE  =  . I6/13X , 18HBACK-UP  FILE  ID  =  .A4.20H.  VERSION  NU 

2MBER  =  .I5.10H.  DATE  =  .16) 

1030  FORMAT  <2X,A3»3X»5A8,3X,8A8) 

1040  FORMAT  (8(2A4»2X)) 

1070  FORMAT  (5X.I2.20H  DATA  GAPS,  ITEMS  =  .3013) 

1080  FORMAT  (27X.30I3) 

10900F0RMAT  ( ////9X.39HHACS  PHYSICAL  PROPERTY  DATA  GAP  SUMMARY/9X, 

1  39(lH-)//5X,44HFIELD  MISSING  ESTIMATED  EXACT  T0TAL/5X, 

2  46HNUMBER  VALUES  VALUES  VALUES  RE3UIRFD/5X,6( 1H-) ,3X, 

3  7(1H-)»2X,9(1H-),2X,6UH-)»3X,8(1H-)) 

1100  FORMAT  (7X»I2»4<5X»I5)) 

1110  FORMAT  (5X.6(lH-),4(3X,5(lH-),2X)/5X»r.HT0TAL,4(3X,I4, JX) // '/ ) 

1120  FORMAT  (5X.38HHACS  PHYSICAL  PROPERTY  DATA  GAP  REPORT////) 

END 

READY, 
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7.2  Message  File  Creation 

Section  7.2  contains  listings  of  three  programs  used  to  create  the  field 
text,  scenario  descriptions  and  model  explanations.  The  original  version 
of  the  program  was  created  to  process  messages  entered  for  HACS  data  field 
explanations;  the  following  two  versions  were  then  created  as  special 
cases  or  simplifications.  Corresponding  to  the  file  load  programs  in  this 
section  are  three  message  display  programs  given  in  Section  7.3. 

The  programs^used  to  create  the  field  text  message  file  were  prepared  to 
provide  for  coded  messages,  and  control  for  either  interactive  or  batch 
processing.  This  allows  for  both  the  initial  file  creation  step,  as  well 
as  any  subsequent  editing  which  may  be  desired. 

The  file  of  scenario  text  data  was  prepared  as  uncoded  messages  using  a 
similar  version  of  the  program.  However,  the  need  for  changing  these 
messages  is  probably  limited. 

The  file  of  model  text  data  was  prepared  using  a  simplified  version  of  the 
program  to  process  model  text  input  in  batch  mode  only. 

Note  that  maximum  message  lengths,  number  of  messages,  format  control 
characters,  and  related  message  attributes  are  different  among  these  three 
programs  and  resulting  files. 
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7.2.1  Field  Text  (File  RGPTXT ) 


OPROGRAM  TXTL0D( INPUT * OUTPUT *TAPE5=INPUT *TAPE6=0UTPUT . 

1  TAPE10*TAPE11 iTAPE12) 

PROGRAM  LOADS  A  MASS  STORAGE  FILE  WITH  COPED  MESSAGE 
TEXT  DATA*  INDEXED  BY  MESSAGE  NUMBER .  TWO  MODES  OF  OPERATION 
ARE  provided:  INTERACTIVE  AND  BATCH.  THE  FILE  IS  INITIALLY 
BUILT  IN  THE  INTERACTIVE  MODE  IN  WHICH  A  SERIES  OF  TEXT 
MESSAGES  ARE  ADDED  TO  THE  PREVIOUS  CONTENTS  OF  THE  MS  FILE. 
MESSAGES  ARE  ADDED  IN  SEQUENCE  BY  MESSAGE  NUMBER  IMMEDIATELY 
FOLLOWING  THE  LAST  MESSAGE  PREVIOUSLY  ENTERED.  INTERACTIVE 
RUNS  MAY  BE  TERMINATED  AND  RE-STARTED  AT  A  LATER  TIME  UNTIL 
THE  FULL  256  MESSAGE  FILE  IS  CREATED.  IN  BATCH  MODE.  A  TEXT 
FILE*  PRODUCED  BY  OUTPUT  FROM  A  SEPARATE  PROGRAM  FOR  ON-LINE 
TEXT  EDITING*  CONTAINING  THE  FULL  SET  OF  TEXT  MESSAGES  IS 
PROCESSED  FROM  START  TO  FINISH.  IN  GENERAL.  ERRORS  ENCOUNTERED 
IN  THE  BATCH  MODE  ARE  IMMEDIATELY  FATAL*  WHILE  THE  PROGRAM 
PERMITS  RECOVERY  FROM  MOST  INTERACTIVE  ERRORS. 

THE  HACS  DEFAULT  FILE  IS  READ  BY  THIS  PROGRAM  TO  OBTAIN 
FIELD  NUMBERS*  NAMES  AND  VARIABLE  TYPES  FOP  USE  IN  DISPLAYS 
AND  TO  CORRELATE  THE  SEQUFNTIAL  MESSAGE  NUMBERS  (FROM  1  TO  256) 
WITH  FIELD  POSITIONS  IN  THE  DEFAULT  FILE. 

THE  MASS  STORAGE  FILE  PRODUCED  BY  THIS  PROGRAM  CONTAINS 
VARIABLE  LENGTH  RECORDS*  INDEXED  NUMERICALLY  BY  A  MESSAGE 
NUMBER  WHICH  RANGES  FROM  1  TO  256.  A  SINGLE  RECORD  IS  CREATED 
IN  THE  FILE  FOR  EACH  MESSAGE  NUMBER.  RECORDS  IN  THE  FTLE 
ARE  CODED  AS  FOLLOWS! 

UNCODED  -  UNCODED  RECORDS  CONTAIN  TEXT  (SEE  BELOW) 

TYPE  1  -  TYPE  1  RECORDS  CONTAIN  3  WORDS  OF  10  CHARACTERS 

TO  CONSTRUCT  THE  MINIMUM  RECORD  SIZE  FOP  A 
CDC  MS  FILE.  THE  FIRST  WORD  CONTAINS  1.H1* 
FOLLOWED  BY  BLANKS*  THE  SECOND  AND  THIRD 
WORDS  ARE  ALSO  BLANK.  TYF’E  1  MESSAGES  ARE 
STANDARDIZED  IN  HACS  AS  REFERENCES  TO  THE 
USER  MANUAL. 

TYPE  2  -  THESE  ARE  SIMILAR  TO  TYPE  1  RECORDS*  BUT 

CONTAIN  1H2  FOLLOWED  BY  BLANKS,  TYPE  2 
MESSAGES  ARE  STANDARDIZED  IN  HACS  AS 
REFERENCES  TO  CHEMICAL  PROPERTY  DATA. 

TYPE  3  -  THESE  ARE  SPECIAL  TYPE  2  RECORDS  FOR  WHICH 

ADDITIONAL  TEXT  IS  ALSO  GIVEN.  THE  FIRST 
WORD  OF  THE  RECORD  CONTAINS  1H3  FOLLOWED  BY 
BLANKS.  THE  REMAINDER  OF  THE  RECORD  CONTAINS 
VARIABLE  LENGTH  TEXT. 


TEXT  CONTAINED  IN  UNCODED  OR  TYPE  3  RECORDS  JS  VARIABLE 
LENGTH  (RECORD  LENGTH  GE  3)*  AND  PACKED  AS  10  CHARACTERS 
PER  WORD.  RECORDS  CONTAIN  ONE  OR  MORE  LINES  OF  MESSAGE 
TEXT  ORIGINALLY  ENTERED  VIA  THIS  PROGRAM  IN  INTERACTIVE  MODE. 
EMBEDDED  BLANKS  BETWEEN  LINES  ARE  AUTOMATICALLY  REMOVED*  AND 
FORTRAN  FORMAT  CODE  FOR  */5X**  IS  AUTOMATICALLY  INSERTED 
BETWEEN  CHARACTER  STRINGS  REPRESENTING  DIFFERENT  LINES.  WHEN 
USED  BY  HACS.  THE  MESSAGE  DATA  IS  READ  INTO  AN  ARRAY  AND 
FORMAT  CODE  APPENDED  TO  THE  BEGINNING  AND  END  OF  THE  ARRAY. 

THE  EXPANDED  ARRAY  IS  THEN  USED  AS  AN  EXECUTION  TIME  FORMAT 
TO  PRODUCE  THE  DESIRED  MESSAGE.  THIS  PROCEDURE  IS  ILLUSTRATED 
IN  THE  AUDIT  PORTION  OF  THE  PROGRAM  BELOW. 

SINCE  THE  MESSAGE  TEXT  IS  STORED  AND  USED  AS  PACKED  CHARACTER 
DATA*  THIS  PROGRAM  IS  SIGNIFICANTLY  MACHINE  DEPENDENT .  OUTPUT 
PRODUCED  BY  THIS  PROGRAM  IS  WRITTEN  AS  10  CHARACTER  WORDS.  IN 
ADDITION  TO  THE  USE  OF  OPEN*  WRITE  AND  CLOSE  MASS  STORAGE 
UTILITY  SUBROUTINES.  THE  CDC  ENCODE  FUNCTION  IS  USED  TO 
PACK  MESSAGE  DATA  READ  IN  A1  FORMAT  TO  A10  FORMAT  FOR  OUTPUT 
TO  THE  MS  FILE. 
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BUFF 

DEFLT 

FORM 

FPCK 

FVAL 

I 

10 

IBLNK 

IBTCH 

IN 

ISTRT 


ISU 

IVAL 

IVAR 

J 


JP 

LEN 

LINE 


LIST 


LP 

m 

MNF 

MNI 


A10  STORAGE  FOR  USER  RESPONSE  TO  VERIFICATION  QUERY, 
ANY  RESPONSE  OTHER  THAN  CARRIAGE  RETURN  REJECTS 
MESSAGE  INPUT. 

EXTERNAL  HACS  DEFAULT  FILE*  READ  TO  OBTAIN  HACS 
FIELD  NUMBER*  FIELD  NAME  AND  FIELD  TYPE  (INTEGER 
OR  REAL)  CORRESPONDING  TO  SEQUENTIAL  FIELD 
MESSAGE  NUMBERS. 

SIX-WORD  ARRAY  CONTAINING  FORMAT  CODE  TO  BE  INSERTED 
BETWEEN  EACH  LINE  OF  MULTIPLE  LINE  MESSAGES. 

ARRAY  EQUIVALENCED  TO  PACKED  MESSAGE  TEXT.  AND  CON¬ 
TAINING  STANDARD  FORMAT  CODE  IN  FIRST  WORD 

ARRAY  OF  DEFAULT  VALUES.  MINIMUM  AND  MAXIMUM  FOR 
REAL  HACS  DATA  FIELDS.  READ  AS  PART  OF  DEFAULT 
FILE  BUT  NOT  OTHERWISE  USED  IN  THIS  PROGRAM. 

GENERAL  LOOP  INDEX 

FIRST  CHARACTER  OF  ARRAY  TEXT  FOR  START  OF  PACK  INTO 
ARRAY  PACK.  SET  TO  1  FOR  UNCODED  MESSAGES  OR  TO  2 
FOR  TYPE  3  MESSAGES. 

DATA  WORD  SET  TO  ALL  BLANKS  FOR  USE  IN  INITIALIZING 

rUAPATIFP  IMPTAftl  FS 

DEVICE  NUMBER  FOR  BATCH  INPUT  FILE  WHEN  RUNNING  IN 
BATCH  MODE 

INPUT  DEVICE  NUMBER  SET  TO  EITHER  TTY  OR  IBTCH  VIA 
USER  CONTROL  AT  START  OF  RUN 

INDEX  NUMBER  OF  LAST  MESSAGE  PREVIOUSLY  LOADED  ONTO 
MASS  STORAGE  FILE.  EACH  RUN  OF  PROGRAM  IN  THE 
INTERACTIVE  MODE  ADDS  MESSAGES  SEQUENTIALLY  BY  1 
FROM  ISTRT+1  UP  TO  A  MAXIMUM  OF  256.  IN  BATCH 
MODE.  A  BULK  RE-CREATION  OF  THE  MS  FILE  BUILDS  ALL 
MESSAGES  FROM  1  TO  256. 

CONTROL  FLAG  SET  TO  0  FOR  INTERACTIVE  INPUT.  OR  TO 
1  FOR  BATCH  INPUT. 

ARRAY  OF  DEFAULT  VALUES.  MINIMUM  AND  MAXIMUM  FOR 
INTEGER  HACS  DATA  FIELDS.  READ  AS  PART  OF  DEFAULT 
FILE  BUT  NOT  OTHERWISE  USED  IN  THIS  PROGRAM. 

CODED  FIELD  TYPE  INDICATOR  PACKED  IN  ARRAY  LIST  FOR 
EACH  HACS  DATA  FIELD  (0=INTEGER  FIELD.  1=REAL  FIELD) 

GENERAL  LOOP  INDEX 

INDEX  TO  LAST  NON-BLANK  CHARACTER  READ  ON  SINGLE 
MESSAGE  LINE 

WORD  INDEX  TO  ARRAY  PACK.  AND  LENGTH  OF  FINAL  PACKED 
MESSAGE  TEXT  (IN  WORDS) 

DUMMY  INDEX.  SET  TO  J+l.  USED  TO  STORE  FORMAT 
TERMINATOR  IN  PACKED  MESSAGE  TEXT  FOR  DISPLAY 
BUT  NOT  OUTPUT  TO  MS  FILE. 

COUNT  OF  CHARACTERS  IN  TEXT  TO  BE  MOVED  TO  ARRAY 
PACK  IN  A10  FORMAT 

BUFFER  USED  FOR  STORAGE  OF  SINGLE  INPUT  LINE  OF 
MESSAGE  TEXT  IN  A1  FORMAT.  LENGTH  SET  TO  130 
CHARACTERS  FOR  USE  WITH  WIDE-BODY  TERMINALS.  HOWEVER 
ACTUAL  MESSAGE  LENGTH  IS  LIMITED  TO  70  CHARACTERS 
PER  LINE 

ARRAY  OF  CODES  IN  HACS  DEFAULT  FILE  DEFINING 

STRUCTURE  OF  DATA  FIELD  ITEM  I  AS  LIST ( I . J )  WHERE 
J=1.6,  LIST < 1 . 1 )  GIVES  FIELD  NUMBER  FOR  FIELD  I 
AND  LIST ( I . J) . J=3 .5.  GIVES  FIELD  NAME.  ELEMENT  2 
CONTAINS  CODED  SOURCE  CODE.  VARIABLE  TYPE  AND 
QUANTITY  TYPE.  ELEMENT  6  IS  INDEX  TO  STORAGE 
OF  NUMERIC  VALUES  IN  FVAL  OR  IVAL.  REFER  TO  HACS 
PROGRAM  DOCUMENTATION  FOR  COMPLETE  DETAILS. 

UNIT  DEVICE  FOR  PROGRAM  OUTPUT  IN  EITHER  BATCH  OR 
INTERACTIVE  MODES 

COUNT  OF  TOTAL  NUMBER  OF  MESSAGE  CHARACTERS 
ACCUMULATED  IN  ARRAY  TEXT 

MAXIMUM  NUMBER  OF  REAL  FIELD  ITEMS  ALLOWED  IN  HACS 
DEFAULT  FILE.  READ  FROM  DEFAULT  FILE  BUT  NOT 
OTHERWISE  USED  IN  THIS  PROGRAM. 

MAXIMUM  NUMBER  OF  INTEGER  FIELD  ITEMS  ALLOWED  IN  HACS 
DEFAULT  FILE.  READ  FROM  DEFAULT  FILE  BUT  NOT 
OTHERWISE  USED  IN  THIS  PROGRAM, 
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TWO 

UDFLT 

UTXT 

ZER 


DATA  WORD  CONTAINING  LABELS  USED  IN  MESSAGE  INPUT 
PROMPT  DISPLAY  FOR  REAL  OF:  INTEGER  FIELDS. 

TEXT  LABEL  STORED  AS  PART  OF  DEFAULT  FILE 
FILE  TABLE  USED  BY  MASS  STORAGE  ROUTINES.  DIMENSIONED 
TO  NUMBER  OF  TEXT  MESSAGES  +  1 
ACTUAL  NUMBER  OF  REAL  DATA  FIELDS  CONTAINED  IN  MACS 
DEFAULT  FILE 

TOTAL  NUMBER  OF  DATA  FIFLDS  STORED  IN  HACS  DEFAULT 
FILE  <=NF+NI).  DEFINITIONS  OF  EACH  MESSAGE  ARE 
STORED  SEQUENTIALLY  IN  ARRAY  LIST. 

ACTUAL  NUMBER  OF  INTEGER  DATA  FIELDS  CONTAINED  IN  HACS 
DEFAULT  FILE 

LINE  COUNTER.  USED  TO  LIMIT  MULTIPLE  LINE  TEXT 

MESSAGES  TO  NOT  MORE  THAN  9  LINES  OF  TEXT  FOLLOWED 
BY  SINGLE  BLANK  LINE  AS  A  DELIMITER. 

DATA  UORD  CONTAINING  TAG  FOR  CODED  MESSAGES.  TYPE  1 
ARRAY  CONTAINING  PACKED  MESSAGE  TEXT  DATA  TO  BE 
WRITTEN  TO  MS  FILE. 

DATA  UORD  CONTAINING  CHARACTERS  TO  CLOSE  MESSAGE 
IN  PACK  FOR  USE  AS  EXECUTION  TIME  FORMAT 
ARRAY  USED  TO  ACCUMULATE  MESSAGE  LINE  INPUT  AND 
FORMAT  CONTROL  LINE  SEPARATION  CHARACTERS  IN 
SINGLE  CHARACTER  <A1>  FORMAT.  ALL  EMBEDDED  BLANKS 
BETWEEN  LINFS  ARE  REMOVED  BEFORE  PACKING. 

DATA  UORD  CONTAINING  TAG  FOR  CODED  MESSAGES.  TYPE  3 
DEVICE  NUMBER  USED  FOR  INPUT  UNIT  WHEN  RUNNING  IN 
INTERACTIVE  MODE 

DATA  UORD  CONTAINING  TAG  FOR  CODED  MESSAGES.  TYPE  2 
UNIT  DEVICE  NUMBER  FOR  EXTERNAL  HACS  DEFAULT  FILE 
UNIT  DEVICE  NUMBER  FOR  EXTERNAL  MS  MESSAGE  TEXT  FILE 
DATA  UORD  CONTAINING  TAG  USED  TO  TEST  FOR  USER 
TERMINATION  OF  INTERACTIVE  TERMINAL  SESSION. 


AUTHOR  -  R.G.  FOTTS 

ARTHUR  I».  LITTLE..  INC. 

35/318A  ACORN  PARK 
CAMBRIDGE.  MASS,  02140 
TEL.  617-864-5770.  EXT,  2813 

DATE  -  22  JULY  19S0 


OCOMMON/BASE/MSGQO)  .MNF.MNI.NF.  NI.LISK  275.6). 
1  FVALC225.3).IVAL<50,3) 

REAL  MSG 

DIMENSION  DEFLT (2489) 

EQUIVALENCE  (DEFLT ( 1 ! , MSG( 1 ) ' 


ODIMENSION  F0RM(6).FF’CK(71 ). LINE ( 130) »MDD( 2 .?) .NDEXC257) . 

1  PACK (70) .TEXT (684) 

OINTEGER  BUFF.  FORM. FPCK. ONE .PACK, TERM. TEXT. THR, TTY, TWO. 

1  UDFLT.UTXT.ZEF: 

EQUIVALENCE  (FPCK(2> ,PACK( 1> ) 


DATA 

DATA 

ODATA 

1 

2 


(FORM( I ) . 1=1 »6)/3H* . 1H/ . 1H5 . 1HX. 1H» . 1H* / 

FPCK ( 1 > /l OH < 5X ,  ’ / » IBLNK/1H  /, IBTCH/12/.LP/6/ 
MOD( 1 , 1 )/4HINTE/ . MOD( 1 .2) /3HGER/ ,M0D(2»  D/4HREAL/, 
MOD ( 2 . 2 > / 1H  /, ONE/ 1H1/.TERM/2H’ J/.THR/IH3/, TTY/5/, 
TU0/1H2/, UDFLT/ 1 0/ , UTXT/1 1 / , ZER/1H0/ 


. SELECT  BATCH  OR  INTERACTIVE  INPUT  UNIT 

10  WRITE(TTY.IOOO) 

IF(EOF( TTY) >  20,20 
20  READ(TTY.IOIO)  ISW 
IF( ISW.EQ.O)  GQ  TO  30 
IF ( ISW.NE . 1 )  GO  TO  10 
IN=IBTCH 
GO  TO  40 
30  IN=TTY 
40  CONTINUE 
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-—READ  EXTERNAL  DEFAULT  FILE  CONTAINING  FIELD  NUMBERS  AND 
NAMES  INDEXED  SEQUENTIALLY. 

REWIND  UDFLT 
READ(UDFLT)  DEFLT 


- PROGRAM  ASSUMES  DEFAULT  FILE  CONTAINS  EXACTLY  256  ENTRIES. 

NFLD=NF+NI 

IF(NFLD,EQ.256>  GO  TO  50 
WRITE(LP* 1020) 

STOP 

50  CONTINUE 


- OPEN  MASS  STORAGE  MESSAGE  FILE.  INDEXED  BY  MESSAGE  NUMBER 

CALL  0PENHS(UTXT.NDEX*257*0) 


- READ  AND  VALIDATE  NUMBER  OF  LAST  MESSAGE  ENTERED  TO  INITIALIZE 

START  OF  SEQUENCE. 

60  IF(ISW.EQ.O)  WRITELTTY * 1030) 

IF<E0F(IN) )  70*70 
70  READ( IN* 1040)  ISTRT 
IF ( ISTRT.LT .0)  GO  TO  80 
IFdSTRT .LE.256)  GO  TO  90 
80  WRITE(LF’*1050) 

IF (ISU.EQ.O)  GO  TO  60 
STOP 

90  CONTINUE 


- START  OF  EACH  NEW  CYCLE  FOR  NEXT  MESSAGE.  CLOSE  FILE  AND  STOP 

AFTER  256  MESSAGES  ARE  STORED. 

100  ISTRT=ISTRT+1 

IFdSTRT. LE.256)  GO  TO  120 
110  CALL  CLOSMS <  UTXT ) 

STOP 

120  CONTINUE 


- READ  SINGLE  LINE  FROM  BATCH  INPUT  FILE  (SKIP  FOR  INTERACTIVE 

INPUT).  LINE  IN  FILE  GIVES  MESSAGE  NUMBER.  HACS  FIELD  NUMBER 
AND  HACS  FIELD  NAME  FOR  REFERENCE  USE.  ONLY  THE  MESSAGE 
NUMBER  IS  READ  AND  MUST  MATCH  THE  SEQUENCE  COUNT  JSTRT. 
IF(ISW.EQ.O)  GO  TO  130 
REABdN*  1040)  NMSG 
IF(NMSG.EQ. ISTRT)  GO  TO  130 
WRITE(LF* 1060)  NMSG 
STOP 


- WRITE  PROMPT  DISPLAY  FOR  EITHER  INTERACTIVE  OR  BATCH  INPUT 

GIVING  THE  MESSAGE  NUMBER*  FIELD  MODE*  NUMBER  AND  NAME. 

130  IVAR=LIST(ISTRT*2)/1000 
IVAR=I VAR+1 

0WRITE(LP> 1070)  ISTRT *( MOBd VAR  *  I >  *  1  =  1 *2 )* LIST ( ISTRT *  1 ) * 

1  (LI ST (ISTRT  *  J) * J=3* 5) 


- INITIALIZE  FOr  ACCUMULATION  OF  MULTIPLE  LINE  MESSAGES 

M=0 

DO  140  1=1*684 
140  TEXT ( I ) =IBLNK 
DO  150  1=1*70 
150  PACK ( I ) =IBLNK 
NLIN=0 


- . -RETURN  HERE  TO  READ  EACH  NEW  LINE  OF  MULTIPLE  LINE  MESSAGE. 

OR  BLANK  LINE  TERMINATING  MESSAGE.  INITIALIZE. 

160  NLIN=NLIN+1 
170  DO  180  1=1*130 
180  LINEd )  =  IBLNK 


- READ  INPUT  LINE  OF  UP  TO  130  CHARACTERS  IN  A1  FORMAT.  THE 

FORMAT  FOR  INTERACTIVE  INPUT  SUPPRE3SFS  LFADING  SPACES.  FOR 
BATCH  INPUT*  THE  TEXT  JS  PRECEDED  BY  FIVE  SPACES  SINCE  THE 
BATCH  FILE  CREATED  FOR  EDITING  IS  PREPARED  BY  EXECUTING  THE 
PREVIOUS  MESSAGES  AS  FORMAT  STATEMENTS. 

I F ( EOF (IN) )  190.190 
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190  CONTINUE 

IFdSW.EQ.O)  READ ( IN, 1080 )  LINE 
IF ( ISW.EQ. 1 )  READ( IN, 1090)  LINE 


. LOCATE  THE  LAST  NON-BLANK  CHARACTER  READ  ON  THE  INPUT  LINE. 

DO  200  1=1 , 130 
j=131-I 

IF(LINE( J) .NE.IBLNK)  GO  TO  210 
200  CONTINUE 
J=0 

210  CONTINUE 


- J  GIVES  THE  INDEX  TO  THE  LAST  NON-BLANK  CHARACTER  READ  ON 

INPUT.  VALID  TEXT  LINES  MAY  BE  BLANK  IF  NOT  THE  FIRST  LINE, 
AND  MAY  NOT  CONTAIN  MORE  THAN  70  CHARACTERS  OF  TEXT, 
IF(J,LE.70)  GO  TO  220 


- SINGLE  LINE  OVERFLOW. 

WRITE(LP» 1100)  NLIN 
IF ( ISW.EQ. 1 )  STOP 
GO  TO  170 


. TEST  FOR  LAST  LINE  (BLANK)  TERMINATING  MESSAGE. 

220  IF(J.GT.O)  GO  TO  230 


- IF  BLANK  LINE  IS  PRECEDED  BY  TEXT,  HAVE  VALID  END  OF  MESSAGE. 

BRANCH  TO  PROCESS.  OTHERWISE,  HAVE  ERROR. 

IF(M.GT.O)  GO  TO  270 
WRITE(LP,1110) 

IF(ISW.EQ.l)  STOP 
GO  TO  170 


- GET  HERE  WITH  MESSAGE  TEXT  ENTERED  FOR  SINGLE  LINE.  TEXT 

MESSAGES  ARE  ALLOWED  FOR  UP  TO  9  NON-BLANK  LINES  OF  TEXT, 
ERROR  OCCURS  IF  MORE  THAN  9  LINES  ARE  ENTERED. 

230  IF(NLIN.LE,9)  GO  TO  240 
WRITE(LP,1120> 

IF ( ISW.EQ. 1 )  STOP 
GO  TO  130 


AN 


. APPEND  NEW  LINE  OF  TEXT  TO  ACCUMULATED  MESSAGE  TEXT,  INSERT 

OUTPUT  FORMAT  CONTROL  AT  END  OF  EACH  NEW  LINE,  THEN  RETURN  TO 
READ  NEXT  TEXT  LINE  OR  BLANK  DELIMITER. 

240  DO  250  1=1, J 
M=M+1 

250  TEXT(M)=LINE ( I ) 

DO  260  1=1,6 
M=M+1 

260  TEXT(M)=FORM( I ) 

GO  TO  160 


. BLANK  LINE  HAS  BEEN  READ  'SMTNATING  VALID  MESSAGE. 

LAST  FORMAT  CONTROL  IN  TEXf. 

270  DO  280  1=1,6 
TEXT(M)=IBLNK 
280  M=M-1 


REMOVE 


- CHECK  FOR  CODES  IN  MESSAGE  TEXT.  0  TERMINATES  THE  RUN* 

CODES  1  AND  2  PRODUCE  BLANK  (NULL)  MESSAGES. 
IF(TEXTd).EQ.ZER)  GO  TO  110 
IF(TEXT(1) .EQ.ONE)  GO  TO  300 
IF(TEXT < 1 ) . EQ.TWO)  GO  TO  300 


AND 


- MESSAGE  IS  EITHER  UNCODED,  OR  CODED  AS  3.  IF  MESSAGE  IS 

UNCODED,  PACK  1  TO  M  CHARACTERS  FROM  TEXT  INTO  WORDS  1  TO  J 
OF  ARRAY  PACK.  IF  MESSAGE  IS  CODED  AS  3,  SET  PACKd )  TO  CODE 
THEN  PACK  2  TO  M  CHARACTERS  FROM  TEXT  INTO  WORDS  2  TO  J  OF 
PACK,  MOVE  TO  AUDIT  AND  FILE  UPDATE  WHEN  DONE, 
IF(TEXTd).EQ.THR)  GO  TO  290 
10=1 
LEN=M 
J*LEN+9 
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J=J/10 
GO  TO  295 
290  10*2 
LEN=M-1 
J=LEN+9 
J=J/10 
J=J+1 

PACK( 1)=TEXT ( 1 ) 

IF(M.GT.l)  GO  TO  295 
URITE(LP*1110) 

IF (ISW.EQ. 1 )  STOP 
GO  TO  130 

295  ENCODE ( LEN* 1130* PACK < 10) )  (TEXT ( I )  * I=I0*M) 


-—PACKED  HESSAGE  LENGTH  CANNOT  BE  LESS  THAN  MINIMUM  RECORD  LENGTH 
IF( J.GE.3)  GO  TO  310 
WRITE(LP*1135) 

IF(ISU.EQ.l)  STOP 
GO  TO  130 


- PREPARE  OUTPUT  FOR  MESSAGES  CODED  AS  1  OR  2.  CODE  WORD  IS 

FOLLOWED  BY  TUO  BLANK  UORDS  FOR  MINIMUM  MESSAGE  LENGTH  OF  3 
WORDS. 

300  J=3 

PACK ( 1 ) =TEXT ( 1 ) 

PACK(2)=IBLNK 

PACK(3)=IBLNK 


- DISPLAY  MESSAGE  FROM  PACKED »  CODED  FORMAT 

310  IF ( PACK (1 ) .EQ.ONE)  GO  TO  320 
IF (PACK( 1 ) .EQ. TWO)  GO  TO  320 
IF(PACK( 1 ) .EQ.THR)  GO  TO  320 
WRITE(LP*1140) 

JP=J+1 

PACK( JP)=TERM 
WRITE(LPfFPCK) 

GO  TO  330 

320  WRITE(LP*1150)  PACK(l) 

IF(PACK(1) .NE.THR)  GO  TO  330 
JP=J+1 

PACK( JP)=TERM 
PACK( 1 )=FPCK ( 1 ) 

WRITE(LPfPACK) 

PACK( 1 )=THR 


. —AFTER  AUDIT *  IN  INTERACTIVE  MODE*  QUERY  USER  FOR  VERIFICATION. 

ANY  NON-BLANK  RESPONSE  CANCELS  MESSAGE. 

330  IF ( ISU.EQ . 1 >  GO  TO  350 
WRITE(LP* 1160) 

BUFF=IBLNK 
IF(EOF (IN ) )  340*340 
340  READ( IN* 1170)  BUFF 

IF(BUFF.NE.IBLNK)  GO  TO  130 


. WRITE  MESSAGE  TO  OUTPUT  FILE*  THEN  REPEAT  ENTIRE  PROCESS 

FOR  NEXT  MESSAGE*  UP  TO  256  MESSAGES. 

350  CALL  WRITMS(UTXT*PACK* J* ISTRT ) 

GO  TO  100 

* 

10000F0RMAT  (//40H  HACS  DATA  FIELD  MESSAGE  UPDATE  PR0GRAM//47H  ENTER 
10  FOR  INTERACTIVE  OR  1  FOR  BATCH  INPUT?) 

1010  FORMAT  (ID 

10200FORMAT  <5X*54H**mERRQR  -  DFFAULT  FILE  DOES  NOT  CONTAIN  256  ENTRI 
1ES) 

1030  FORMAT  (//50H  ENTER  NUMBER  OF  LAST  MESSAGE  SAVED  IN  13  FORMAT?) 
1040  FORMAT  (13) 

10500FORMAT  (5X*54H*m*ERR0R  -  LAST  MESSAGE  NUMBER  NOT  IN  RANGE  0  TO  2 
156) 

10600F0RMAT  (5X*21H**»«ERR0R  -  HESSAGE  *I3*33H  IS  OUT  OF  SEQUENCE  ON  I 
INPUT  FILE) 

10700F0RMAT  (/5X*34HENTER  0  OR  CODED  TEXT  FOR  MESSAGE  *I3*2H*  *A4*A3» 

1  7H  FIELD  *  14* 2X*3A4* 1H? / ) 


v 


MESSAGE  EXCEEDS  MAXIMUM  LENGTH  OF  9  LIN 


1080  FORMAT  (130A1) 

1090  FORMAT  (5X>130A1) 

11000F0RMAT  (5X» 18H*****ERR0R  -  LINE  »I2*48H  EXCEEDS  LENGTH  OF  70  CHARA 
1CTERS*  RE-ENTER  LINE») 

11100F0RMAT  <5X»68H*****ERR0R  -  MESSAGE  NOT  FOUND.  ENTER  TEXT  FOLLOWED 
1BY  A  BLANK  LINE.) 

11200F0RMAT  <5X.73H*m*ERR0R 
1ES.  RE-ENTER  MESSAGE.) 

1130  FORMAT  (684A1) 

11350F0RMAT  <5X»82H***#*ERR0R  -  MESSAGE  TOO  SHORT  (MINIMUM  LENGTH  =  21 
1CHARACTERS) .  RE-ENTER  MESSAGE.) 

1140  FORMAT  (5X»24HMESSAGE  IS  UNCODED  TEXT!/) 

1150  FORMAT  (5X.25HMESSAGE  IS  CODED  AS  TYRE  »A1/) 

1160  FORMAT  (4H  OK?) 

1170  FORMAT  (A10) 

END 


READY. 
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7.2.2  Scenario  Text  (File  RPSTXT) 


OPROGRAM  TXTLODdNPUT , OUTPUT , TAPE5=INPUT ,TAPE6=QUTPUT » 

1  TAPElOi TAPE1 1 » TAPE12 ) 

PROGRAM  LOADS  A  MASS  STORAGE  FILE  UITH  CODED  MESSAGE 
TEXT  DATAr  INDEXED  BY  MESSAGE  NUMBER.  TWO  MODES  OF  OPERATION 
are  provided:  INTERACTIVE  AND  BATCH.  THE  FILE  IS  INITIALLY 
BUILT  IN  THE  INTERACTIVE  MODE  IN  WHICH  A  SERIES  OF  TEXT 
MESSAGES  ARE  ADDED  TO  THE  PREVIOUS  CONTENTS  OF  THE  MS  FILE. 
MESSAGES  ARE  ADDED  IN  SEQUENCE  BY  MESSAGE  NUMBER  IMMEDIATELY 
FOLLOWING  THE  LAST  MESSAGE  PREVIOUSLY  ENTERED.  INTERACTIVE 
RUNS  MAY  BE  TERMINATED  AND  RE-STARTED  AT  A  LATER  TIME  UNTIL 
THE  FULL  256  MESSAGE  FILE  IS  CREATED.  IN  BATCH  MODE,  A  TEXT 
FILE,  PRODUCED  BY  OUTPUT  FROM  A  SEPARATE  PROGRAM  FOR  ON-LINE 
TEXT  EDITINGf  CONTAINING  THE  FULL  SET  OF  TEXT  MESSAGES  IS 
PROCESSED  FROM  START  TO  FINISH.  IN  GENERAL,  ERRORS  ENCOUNTERED 
IN  THE  BATCH  MODE  ARE  IMMEDIATELY  FATAL,  WHILE  THE  PROGRAM 
PERMITS  RECOVERY  FROM  MOST  INTERACTIVE  ERRORS. 

THE  HACS  DEFAULT  FILE  IS  READ  BY  THIS  PROGRAM  TO  OBTAIN 
FIELD  NUMBERS,  NAMES  AND  VARIABLE  TYPES  FOR  USE  IN  DISPLAYS 
AND  TO  CORRELATE  THE  SEQUENTIAL  MESSAGE  NUMBERS  (FROM  1  TO  256) 
WITH  FIELD  POSITIONS  IN  THE  DEFAULT  FILE. 

THE  MASS  STORAGE  FILE  PRODUCED  BY  THIS  PROGRAM  CONTAINS 
VARIABLE  LENGTH  RECORDS,  INDEXED  NUMERICALLY  BY  A  MESSAGE 
NUMBER  WHICH  RANGES  FROM  1  TO  256.  A  SINGLE  RECORD  IS  CREATED 
IN  THE  FILE  FOR  EACH  MESSAGE  NUMBER.  RECORDS  IN  THE  FILE 
ARE  CODED  AS  FOLLOWS ! 

UNCODED  -  UNCODED  RECORDS  CONTAIN  TEXT  (SEE  BELOW) 

TYPE  1  -  TYPE  1  RECORDS  CONTAIN  3  WORDS  OF  10  CHARACTERS 

TO  CONSTRUCT  THE  MINIMUM  RECORD  SI7E  FOR  A 
CDC  MS  FILE.  THE  FIRST  WORD  CONTAINS  1H1, 
FOLLOWED  BY  BLANKS)  THE  SECOND  AND  THIRD 
WORDS  ARE  ALSO  BLANK.  TYPE  I  MESSAGES  ARE 
STANDARDIZED  IN  HACS  AS  REFERENCES  TO  THE 
USER  MANUAL. 

TYPE  2  -  THESE  ARE  SIMILAR  TO  TYPE  1  RECORDS,  BUT 

CONTAIN  1H2  FOLLOWED  BY  BLANKS.  TYPE  2 
MESSAGES  ARE  STANDARDIZED  IN  HACS  AS 
REFERENCES  TO  CHEMICAL  PROPERTY  DATA. 

TYPE  3  -  THESE  ARE  SPECIAL  TYPE  2  RECORDS  FOR  WHICH 

ADDITIONAL  TEXT  IS  ALSO  GIVEN.  THE  FIRST 
WORD  OF  THE  RECORD  CONTAINS  1H3  FOLLOWED  BY 
BLANKS.  THE  REMAINDER  OF  THE  RECORD  CONTAINS 
VARIABLE  LENGTH  TEXT. 


TEXT  CONTAINED  IN  UNCODED  OR  TYPF  3  RECORDS  IS  VARIABLE 
LENGTH  (RECORD  LENGTH  GE  3),  AND  PACKED  AS  10  CHARACTERS 
PER  WORD.  RECORDS  CONTAIN  ONE  OR  MORE  LINES  OF  MESSAGE 
TEXT  ORIGINALLY  ENTERED  VIA  THIS  PROGRAM  IN  INTERACTIVE  MODE. 
EMBEDDED  BLANKS  BETWEEN  LINES  ARE  AUTOMATICALLY  REMOVED,  AND 
FORTRAN  FORMAT  CODE  FOR  V5X,’  IS  AUTOMATICALLY  INSFRTED 
BETWEEN  CHARACTER  STRINGS  REPRESENTING  DIFFERENT  LINES.  WHEN 
USED  BY  HACS,  THE  MESSAGE  DATA  IS  READ  INTO  AN  ARRAY  AND 
FORMAT  CODE  APPENDED  TO  THE  BEGINNING  AND  END  OF  THE  ARRAY. 

THE  EXPANDED  ARRAY  IS  THEN  USED  AS  AN  EXECUTION  TIME  FORMAT 
TO  PRODUCE  THE  DESIRED  MESSAGE.  THIS  PROCEDURE  IS  ILLUSTRATED 
IN  THE  AUDIT  PORTION  OF  THE  PROGRAM  BELOW. 

SINCE  THE  MESSAGE  TEXT  IS  STORED  AND  USED  AS  PACKED  CHARACTER 
DATA,  THIS  PROGRAM  IS  SIGNIFICANTLY  MACHINE  DEPENDENT.  OUTPUT 
PRODUCED  BY  THIS  PROGRAM  IS  WRITTEN  AS  10  CHARACTER  WORDS.  IN 
ADDITION  TO  THE  USE  OF  OPEN,  WRITE  AND  CLOSE  MASS  STORAGE 
UTILITY  SUBROUTINES,  THE  CDC  ENCODE  FUNCTION  IS  USED  TO 
PACK  MESSAGE  DATA  READ  IN  A1  FORMAT  TO  A10  FORMAT  FOR  OUTPUT 
TO  THE  MS  FILE. 
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DEFLT  = 


IBLNK  = 
IBTCH  = 


ISTRT 


A10  STORAGE  FOR  USER  RESPONSE  TO  VERIFICATION  QUERY. 
ANY  RESPONSE  OTHER  THAN  CARRIAGE  RETURN  REJECTS 
MESSAGE  INPUT. 

EXTERNAL  HACS  DEFAULT  FILE*  READ  TO  OBTAIN  HACS 
FIELD  NUMBER*  FIELD  NAME  AND  FIELD  TYPE  (INTEGER 
OR  REAL)  CORRESPONDING  TO  SEQUENTIAL  FIELD 

Message  numbers. 

SIX-UORD  ARRAY  CONTAINING  FORMAT  CODE  TO  BF  INSERTED 
BETWEEN  EACH  LINE  OF  MULTIPLE  LINE  MESSAGES. 

ARRAY  EQUIVALENCED  TO  PACKED  MESSAGE  TEXT*  AND  CON¬ 
TAINING  STANDARD  FORMAT  CODE  IN  FIRST  WORD 

ARRAY  OF  DEFAULT  VALUES*  MINIMUM  AND  MAXIMUM  FOR 
REAL  HACS  DATA  FIELDS.  READ  AS  PART  OF  DEFAULT 
FILE  BUT  NOT  OTHERWISE  USED  IN  THIS  PROGRAM. 

GENERAL  LOOP  INDEX 

FIRST  CHARACTER  OF  ARRAY  TEXT  FOR  START  OF  PACK  INTO 
ARRAY  PACK,  SET  TO  1  FOR  UNCODED  MESSAGES  OR  TO  2 
FOR  TYPE  3  MESSAGES. 

DATA  WORD  SET  TO  ALL  BLANKS  FOR  USE  IN  INITIALIZING 
CHARACTER  VARIABLES 

DEVICE  NUMBER  FOR  BATCH  INPUT  FILE  WHEN  RUNNING  IN 
BATCH  MODE 

INPUT  DEVICE  NUMBER  SET  TO  EITHER  TTY  OR  IBTCH  VIA 
USER  CONTROL  AT  START  OF  RUN 

INDEX  NUMBER  OF  LAST  MESSAGE  PREVIOUSLY  LOADED  ONTO 
MASS  STORAGE  FILE.  EACH  RUN  OF  PROGRAM  IN  THE 
INTERACTIVE  MODE  ADDS  MESSAGES  SEQUENTIALLY  BY  1 
FROM  ISTRT+1  UP  TO  A  MAXIMUM  OF  256.  IN  BATCH 
MODE,  A  BULK  RE-CREATION  OF  THE  MS  FILF  BUILDS  ALL 
MESSAGES  FROM  1  TO  256. 

CONTROL  FLAG  SET  TO  0  FOR  INTERACTIVE  INPUT,  OR  TO 
1  FOR  BATCH  INPUT* 

ARRAY  OF  DEFAULT  VALUES*  MINIMUM  AND  MAXIMUM  FOR 
INTEGER  HACS  DATA  FIELDS.  READ  AS  PART  OF  DEFAULT 
FILE  BUT  NOT  OTHERWISE  USED  IN  THIS  PROGRAM. 

CODED  FIELD  TYPE  INDICATOR  PACKED  IN  ARRAY  LIST  FOR 
EACH  HACS  DATA  FIELD  (0=INTEGER  FIELD,  1=REAL  FIELD) 

GENERAL  LOOP  INDEX 

INDEX  TO  LAST  NON-BLANK  CHARACTER  READ  ON  SINGLE 
MESSAGE  LINE 

WORD  INDEX  TO  ARRAY  PACK*  AND  LENGTH  OF  FINAL  PACKED 
MESSAGE  TEXT  (IN  WORDS) 

DUMMY  INDEX,  SET  TO  J+l,  USED  TO  STORE  FORMAT 
TERMINATOR  IN  PACKED  MESSAGE  TEXT  FOR  DISPLAY 
BUT  NOT  OUTPUT  TO  MS  FILE. 

COUNT  OF  CHARACTERS  IN  TEXT  TO  BE  MOVED  TO  ARRAY 
PACK  IN  AlO  FORMAT 

BUFFER  USED  FOR  STORAGE  OF  SINGLE  INPUT  LINE  OF 
MESSAGE  TEXT  IN  A1  FORMAT.  LENGTH  SET  TO  130 
CHARACTERS  FOR  USE  WITH  WIDE-BODY  TERMINALS*  HOUEVER 
ACTUAL  MESSAGE  LENGTH  IS  LIMITED  TO  70  CHARACTERS 
PER  LINE. 

ARRAY  OF  CODES  IN  HACS  DEFAULT  FILE  DEFINING 

STRUCTURE  OF  DATA  FIELD  ITEM  I  AS  LIST(I,J>  WHERE 
J=1 ,6.  LIST (1,1)  GIVES  FIELD  NUMBER  FOR  FIELD  I 
AND  LIST(I*J) ,J=3*5*  GIVES  FIELD  NAME.  ELEMENT  2 
CONTAINS  CODED  SOURCE  CODE,  VARIABLE  TYPE  AND 
QUANTITY  TYPE.  ELEMENT  6  IS  INDEX  TO  STORAGE 
OF  NUMERIC  VALUES  IN  FVAL  OR  IVAL.  REFER  TO  HACS 
PROGRAM  DOCUMENTATION  FOR  COMPLETE  DETAILS. 

UNIT  DEVICE  FOR  PROGRAM  OUTPUT  IN  EITHER  BATCH  OR 
INTERACTIVE  MODES 

COUNT  OF  TOTAL  NUMBER  OF  MESSAGE  CHARACTERS 
ACCUMULATED  IN  ARRAY  TEXT 

MAXIMUM  NUMBER  OF  REAL  FIELD  ITEMS  ALLOWED  IN  HACS 
DEFAULT  FILE.  READ  FROM  DEFAULT  FILE  BUT  NOT 
OTHERWISE  USED  IN  THIS  PROGRAM. 

MAXIMUM  NUMBER  OF  INTEGER  FIELD  ITEMS  ALLOWED  IN  HACS 
DEFAULT  FILE.  READ  FROM  DEFAULT  FILE  BUT  NOT 
OTHERWISE  USED  IN  THIS  PROGRAM. 
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TWO 

UDFLT 

(JTXT 

ZER 


DATA  WORD  CONTAINING  LABELS  USED  IN  MESSAGE  INPUT 
PROMPT  DISPLAY  FOR  REAL  OR  INTEGER  FIELDS. 

TEXT  LABEL  STORED  AS  PART  OF  DEFAULT  FILE 
FILE  TABLE  USED  BY  MASS  STORAGE  ROUTINES*  DIMENSIONED 
TO  NUMBER  OF  TEXT  MESSAGES  +  1 
ACTUAL  NUMBER  OF  REAL  DATA  FIELDS  CONTAINED  IN  HACS 
DEFAULT  FILE 

TOTAL  NUMBER  OF  DATA  FIELDS  STORED  IN  HACS  DEFAULT 
FILE  C  =NF+NI ) .  DEFINITIONS  OF  EACH  MESSAGE  ARE 
STORED  SEQUENTIALLY  IN  ARRAY  LIST. 

ACTUAL  NUMBER  OF  INTEGER  DATA  FIELDS  CONTAINED  IN  HACS 
DEFAULT  FILE 

LINE  COUNTER*  USED  TO  LIMIT  MULTIPLE  LINE  TEXT 

MESSAGES  TO  NOT  MORE  THAN  9  LINES  OF  TEXT  FOLLOWED 
BY  SINGLE  BLANK  LINE  AS  A  DELIMITER. 

DATA  WORD  CONTAINING  TAG  FOR  CODED  MESSAGES*  TYPE  1 
ARRAY  CONTAINING  PACKED  MESSAGE  TEXT  DATA  TO  BE 
WRITTEN  TO  MS  FILE. 

DATA  WORD  CONTAINING  CHARACTERS  TO  CLOSE  MESSAGE 
IN  PACK  FOR  USE  AS  EXECUTION  TIME  FORMAT 
ARRAY  USED  TO  ACCUMULATE  MESSAGE  LINE  INPUT  AMD 
FORMAT  CONTROL  LINE  SEPARATION  CHARACTERS  IN 
SINGLE  CHARACTER  (Al>  FORMAT.  ALL  EMBEDDED  BLANKS 
BETWEEN  LINES  ARE  REMOVED  BEFORE  PACKING. 

DATA  WORD  CONTAINING  TAG  FOR  CODED  MESSAGES*  TYPE  3 
DEVICE  NUMBER  USED  FOR  INPUT  UNIT  WHEN  RUNNING  IN 
INTERACTIVE  MODE 

DATA  WORD  CONTAINING  TAG  FOR  CODED  MESSAGES*  TYPE  2 
UNIT  DEVICE  NUMBER  FOR  EXTERNAL  HACS  DEFAULT  FILE 
UNIT  DEVICE  NUMBER  FOR  EXTERNAL  MS  MESSAGE  TEXT  FILE 
DATA  WORD  CONTAINING  TAG  USED  TO  TEST  FOP  USER 
TERMINATION  OF  INTERACTIVE  TERMINAL  SESSION. 


AUTHOR  -  R.G.  POTTS 

ARTHUR  D.  LITTLE*  INC. 

35/318A  ACORN  PARK 
CAMBRIDGE*  MASS.  021  40 
TEL.  417-864-5770*  EXT.  2813 

DATE  -  22  JULY  1980 


0C0MH0N/BASE/MSG(10) *MNF*MNI *NF*NI *LIST(275*&) * 

1  FVAL(225*3) * IVAL (30*3) 

REAL  MSG 

DIMENSION  DEFLTC2489) 

EQUIVALENCE  (DEFL 1(1) *MSG< 1 ) ) 

ODIMENSION  FORH<  6) *FPCK<71 )* LINE ( 130) *M0D(2*2) *NDEX(257>  * 

1  PACK (70)* TEXT <684) 

OINTEGER  BUFF  *  FORM *FPCK, ONE* PACK* TERM* TEXT  *THR*TTY  *TWO* 

1  UDFLT  *UTXT  *ZER 

EQUIVALENCE  (FPCKC2) *PACK ( 1 ) > 

DATA  <F0RM(I>*I=1*6)/1H'*1H/*1H9*1HX*1H**1H'/ 

DATA  FPCK< 1 )/10H(9X*  V* IRLNK/1H  /* IBTCH/12/*LP/6/ 

ODATA  MOD< 1  *  1 )/4HINTE/*M0D( 1 *2)/3HGER/*M0D(2* 1 )/4HREAL/ * 

1  M0D(2*2)/1H  t *0NE/IH1/ *  TERM/2H* )/*THR/lH3/ *  TTY/5/* 

2  TW0/1H2/*UDFLT/10/*UTXT/1 1/ * ZER/1H0/ 


. SELECT  BATCH  OR  INTERACTIVE  INPUT  UNIT 

10  WRITE(TTY* 1000 ) 

IF<EOF(TTY>)  20*20 
20  READ(TTY*1010)  ISW 
IF(ISW.EQ.O)  GO  TO  30 
IF(ISW.NE.l)  GO  TO  10 
IN*I8TCH 
GO  TO  40 
30  IN»TTY 
40  CONTINUE 


218 


oonnon  non  oo  n  on  orjooo  non  ooo 


'.'vrt Sj* 


C . READ  EXTERNAL  DEFAULT  FILE  CONTAINING  FIELD  NUMBERS  AND 

C  NAMES  INDEXED  SEQUENTIALLY. 

REWIND  UDFLT 
READ(UDFLT)  DEFLT 
C 

C . PROGRAM  ASSUMES  DEFAULT  FILE  CONTAINS  EXACTLY  256  ENTRIES. 

NFLD*NF+NI 

IF(NFLD,EQ.256>  GO  TO  50 
WRITE(LP» 1020) 

STOP 


50  CONTINUE 
C 

C . OPEN  MASS  STORAGE  MESSAGE  FILE*  INDEXED  BY  MESSAGE  NUMBER 

CALL  0PENHS(UTXT > NDEX, 32,0) 

. READ  AND  VALIDATE  NUMBER  OF  LAST  MESSAGE  ENTERED  TO  INITIALIZE 

START  OF  SEQUENCE. 

60  IF(ISU.EQ.O)  WRITE(TTY,1030> 

IF(EOFUN))  70,70 
70  READ(IN,  1040)  ISTRT 
IF(ISTRT.LT.O)  GO  TO  80 
IF( ISTRT. LE. 31 )  GO  TO  90 
80  WRITE(LP,1050> 

IF(ISW.EQ.O)  GO  TO  60 
STOP 

90  CONTINUE 

. START  OF  EACH  NEW  CYCLE  FOR  NEXT  MESSAGE.  CLOSE  FILE  AND  STOP 

AFTER  256  MESSAGES  ARE  STORED. 

100  ISTRT=ISTRT+1 

IFdSTRT .LE.31)  GO  TO  120 
110  CALL  CLOSMS(UTXT) 

STOP 

120  CONTINUE 


- READ  SINGLE  LINE  FROM  BATCH  INPUT  FILE  (SKIP  FOR  INTERACTIVE 

INPUT).  LINE  IN  FILE  GIVES  MESSAGE  NUMBER,  HAPS  FIFLD  NUMBER 
AND  HACS  FIELD  NAME  FOR  REFERENCE  USE.  ONLY  THE  MESSAGE 
NUMBER  IS  READ  AND  MUST  MATCH  THE  SEQUENCE  COUNT  ISTRT. 
IF(ISU.EQ.O)  GO  TO  130 
READdN,  1040)  NMSG 
IF(NMSG,EQ. ISTRT)  GO  TO  130 
WRITE(LP, 1060)  NMSG 
STOP 


. WRITE  PROMPT  DISPLAY  FOR  EITHER  INTERACTIVE  OR  BATCH  INPUT 

GIVING  THE  MESSAGE  NUMBER,  FIELD  MODE,  NUMBER  AND  NAME. 

130  IVAR=LIST(ISTRT,2>/1000 
IVAR=IVAR+1 

0WRITE(LP,  1070)  ISTRT ,  (MODdVAR,  I )  ,1  =  1 ,2) ,  LIST  (ISTRT ,  1 ) , 

1  (LIST (ISTRT , J) , J=3 ,5 ) 


. INITIALIZE  FOR  ACCUMULATION  OF  MULTIPLE  LINE  MESSAGES 

M=0 

DO  140  1*1,684 
140  TEXT(I)*IBLNK 
DO  150  1*1,70 
150  PACKd >=IBLNK 
NLIN*0 


. RETURN  HERE  TO  READ  EACH  NEW  LINE  OF  MULTIPLE  LINE  MESSAGE, 

OR  BLANK  LINE  TERMINATING  MESSAGE.  INITIALIZE. 

160  NLIN*NLIN+1 
170  DO  180  1*1,130 
180  LINE(I)*IBLNK 


-READ  INPUT  LINE  OF  UP  TO  130  CHARACTERS  IN  A1  FORMAT,  THE 
FORMAT  FOR  INTERACTIVE  INPUT  SUPPRESSES  LEADING  SPACES,  FOR 
BATCH  INPUT,  THE  TEXT  IS  PRECEDED  BY  FIVE  SPACES  SINCE  THE 
BATCH  FILE  CREATED  FOR  EDITING  IS  PREPARED  BY  EXECUTING  THE 
PREVIOUS  MESSAGES  AS  FORMAT  STATEMENTS. 


IF(EOFdN))  190,190 
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190  CONTINUE 

IF(ISU.EO.O)  READ( IN* 1080)  LINE 
IF(ISW.EQ.l)  REAIM IN* 1090)  LINE 


. LOCATE  THE  LAST  NON-BLANK  CHARACTER  READ  ON  THE  INPUT  LINE, 

DO  200  1*1 » 130 
J=131-I 

IF(LINE( J) *NE»IBLNK)  GO  TO  210 
200  CONTINUE 
J=0 

210  CONTINUE 


- J  GIVES  THE  INDEX  TO  THE  LAST  NON-BLANK  CHARACTER  READ  ON 

INPUT.  VALID  TEXT  LINES  HAY  BE  BLANK  IF  NOT  THE  FIRST  LINE* 
AND  HAY  NOT  CONTAIN  MORE  THAN  70  CHARACTERS  OF  TEXT. 

IF( J.LE.70)  GO  TO  220 


- SINGLE  LINE  OVERFLOW. 

WRITE(LP*1100)  NLIN 
IF(ISW.EQ.l)  STOP 
GO  TO  170 


. —TEST  FOR  LAST  LINE  (BLANK)  TERHINATING  MESSAGE. 

220  IF(J.GT.O)  GO  TO  230 


—  IF  BLANK  LINE  IS  PRECEDED  BY  TEXT*  HAVE  VALID  END  OF  HESSAGE, 
BRANCH  TO  PROCESS.  OTHERWISE*  HAVE  ERROR. 

IF(M.GT.O)  GO  TO  270 
WRITE(LP*1110) 

IF(ISU.EQ.l)  STOP 
GO  TO  170 


. GET  HERE  WITH  MESSAGE  TEXT  ENTERED  FOR  SINGLE  LINE.  TEXT 

MESSAGES  ARE  ALLOWED  FOR  UP  TO  9  NON-BLANK  LINES  OF  TEXT. 
ERROR  OCCURS  IF  MORE  THAN  9  LINES  ARE  ENTERED. 

230  IF(NLIN.LE,9)  GO  TO  240 
WRITE(LP,1120) 

IF(ISW.EQ.l)  STOP 
GO  TO  130 


AN 


-APPEND  NEW  LINE  OF  TEXT  TO  ACCUMULATED  MESSAGE  TEXT*  INSERT 

-  - ..... -  -  1ETURK 


OUTPUT  FORMAT  CONTROL  AT  END  OF  EACH  NEW  LINE*  THEN  RETURN  TO 
READ  NEXT  TEXT  LINE  OR  BLANK  DELIMITER. 

240  DO  250  1=1 *J 
M=M+1 

250  TEXT(M)=LINE ( I ) 

DO  260  1=1*6 
M=M+1 

260  TEXT(M)=FORN( I ) 

GO  TO  160 


- BLANK  LINE  HAS  BEEN  READ  TERMINATING  VALID  MESSAGE. 

LAST  FORMAT  CONTROL  IN  TEXT. 

270  DO  280  1=1*6 
TEXT(M)=IBLNK 
280  M=M-1 


REMOVE 


- CHECK  FOR  CODES  IN  MESSAGE  TEXT.  0  TERMINATES  THE  RUN*  AND 

CODES  1  AND  2  PRODUCE  BLANK  (NULL)  MESSAGES. 
IF(TEXTd).EQ.ZER)  GO  TO  110 
IF(TEXTd).EQ.ONE)  GO  TO  300 
IF(TEXTd).EQ.TWO)  GO  TO  300 


-MESSAGE  IS  EITHER  UNCODED*  OR  CODED  AS  3.  IF  MESSAGE  IS 
UNCODED*  PACK  1  TO  H  CHARACTERS  FROM  TEXT  INTO  WORDS  1  TO  J 


?Ee8WSC!!* 


(  2  TO  M 
PACK.  MOVE  TO  A 
IF(TEXTd)  .EO.THR) 
10*1 
LEN=M 
J=LEN+9 


IEH8IE??ils,FR88t?fx8s.EtosE5RE8c§<H50oF0,’E 


.IT  AND  FILE  UPDATE  WHEN  DONE, 
0  TO  290 
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J= J/10 
GO  TO  295 
290  10=2 
LEN=M-1 
J=LEN+9 
J=J/10 
J=J+1 

PACKd  )=TEXT ( 1 ) 

IF(M.GT.l)  GO  TO  295 
URITE(LP*1110) 

IF(ISU.EQ.l)  STOP 
GO  TO  130 

295  ENCODE ( LEN* 1130* PACK < 10) )  (TEXT(I) *I=I0*M) 


- PACKED  MESSAGE  LENGTH  CANNOT  BE  LESS  THAN  MINIMUM  RECORD  LENGTH 

IFU.GE.3)  GO  TO  310 
WRITE(LP*1135) 

IF(ISU.EQ.l)  STOP 
GO  TO  130 


- PREPARE  OUTPUT  FOR  MESSAGES  CODED  AS  1  OR  2.  CODE  WORD  IS 

FOLLOWED  BY  TWO  BLANK  WORDS  FOR  MINIMUM  MESSAGE  LENGTH  OF  3 
WORDS. 

300  J=3 

PACK( 1 )=TEXT (1 ) 

PACK(2)=IBLNK 
PACK(3)= IBLNK 


- DISPLAY  MESSAGE  FROM  PACKED*  CODED  FORMAT 

310  IF(PACK(1) .EQ.ONE)  GO  TO  320 

IF(PACK(1) .EQ.TWO)  GO  TO  320 

IF(PACKd).EQ.THR)  GO  TO  320 

MRITE(LP  >1140) 

JP=JF1 

PACK( JP)=TERM 
WRITE(LPfFPCK) 

GO  TO  330 

320  WRITE(LP»1150)  PACKd) 

IF(PACK(1) .NE-THR)  GO  TO  330 
JP=J+1 

PACK( JP)=TERM 
PACKd  )=FPCK(1 ) 

WRITE(LP» PACK) 

PACKd  )=THR 


- AFTER  AUDIT »  IN  INTERACTIVE  MODE*  QUERY  USER  FOR  VERIFICATION. 

ANY  NON-BLANK  RESPONSE  CANCELS  MESSAGE. 

330  IFdSW.EQ.l)  GO  TO  350 
WRITE(LP*1160) 

BUFF=IBLNK 
IF(EOF ( IN ) )  340*340 
340  READCIN*  1170)  BUFF 

IF(BUFF.NE. IBLNK)  GO  TO  130 


. -WRITE  MESSAGE  TO  OUTPUT  FILE*  THEN  REPEAT  ENTIRE  PROCESS 

FOR  NEXT  MESSAGE*  UP  TO  256  MESSAGES. 

350  CALL  WRITMS(UTXT *PACK* J.ISTRT) 

GO  TO  100 

'lOOOOFORMAT  (//40H  HACS  DATA  FIELD  MESSAGE  UPDATE  PR0GRAM//47H  ENTER 
10  FOR  INTERACTIVE  OR  1  FOR  BATCH  INPUT?) 

1010  FORMAT  (ID 

10200FORMAT  (5X»54H*****ERR0R  -  DEFAULT  FILE  DOES  NOT  CONTAIN  256  ENTRI 
1ES) 

1030  FORMAT  <//50H  ENTER  NUMBER  OF  LAST  MESSAGE  SAVED  IN  13  FORMAT?) 
1040  FORMAT  (13) 

10500F0RMAT  (5X*54H*m*ERR0R  -  LAST  MESSAGE  NUMBER  NOT  IN  RANGE  0  TO  2 
156) 

10600F0RMAT  (5X*21HtmtERR0R  -  MESSAGE  *I3*33H  IS  OUT  OF  SEQUENCE  ON  I 
INPUT  FILE) 

10700F0RMAT  (/5X.34HENTER  0  OR  CODED  TEXT  FOR  MESSAGE  *I3*2H*  *A4*A3* 

1  7H  FIELD  *  14* 2X*3A4* lHS / ) 
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1080  FORMAT  (130A1) 

1090  FORMAT  <9X»130A1) 

11000F0RMAT  (5X» 18H*m*ERR0R  -  LINE  iI2.48H  EXCEEDS  LENGTH  OF  70  CHARA 
1CTERS.  RE-ENTER  LINE.) 

11100F0RMAT  (5X»68H****$ERR0R  -  MESSAGE  NOT  FOUND.  ENTER  TEXT  FOLLOWED 
IBY  A  BLANK  LINE.) 

11200F0RMAT  (5X»73H**I**ERR0R  -  MESSAGE  EXCEEDS  MAXIMUM  LENGTH  OF  9  LIN 
1ES.  RE-ENTER  MESSAGE.) 

1130  FORMAT  (684A1) 

11350F0RMAT  (5X»82H*****ERR0R  -  MESSAGE  TOO  SHORT  (MINIMUM  LENGTH  =  21 
1CHARACTERS).  RE-ENTER  MESSAGE.) 

1140  FORMAT  (5X»24HMESSAGE  IS  UNCODED  TEXT!/) 

1150  FORMAT  <5X. 25HMESSAGE  IS  CODED  AS  TYPE  ,Al/> 

1160  FORMAT  (4H  OK?) 

1170  FORMAT  (A10) 

END 


READY. 


222 


no on on ooooo 


7.2.3  Model  Text  (File  MTXLOD ) 

PROGRAM  MTXLOD ( OUTPUT , TAPE6=0UTPUT * TAPE11 *  TAPC12 ) 

PROGRAM  MTXLOD  (FOR  MESSAGE  TEXT  LOAD)  WAS  CREATED  BY  ADAPTING 
THE  FIELD  TEXT  LOAD  PROGRAM  FOR  THE  FOLLOWING  SPECIAL  CASE. 

ONLY  BATCH  INPUT  IS  ALLOWED  FROM  A  FILE  OF  UNCODED  MESSAGE 
TEXT  DATA.  EACH  MESSAGE  IS  SEPARATED  BY  A  BLANK  LINE*  CONTAINS 
AT  LEAST  ONE  LINE  OF  TEXT*  AND  A  MAXIMUM  OF  25  LINES  OF  TEXT. 
EACH  LINE  IS  LIMITED  TO  NOT  MORE  THAN  70  CHARACTERS.  THE 
COMPLETE  FILE  CONTAINS  EXACTLY  29  MESSAGES.  REFER  TO  LISTING 
OF  PROGRAM  TXTLOD  FOR  DEFINITIONS  AND  ADDITIONAL  INFORMATION. 


ODIMENSION  F0RM(6) *FPCK( 192) *LINE(80) *NDEX(30) *PACK< 191 ) * 
1  TEXT (1900 ) 

INTEGER  FORM »FPCK. PACK* TERM* TEXT *UTXT 

EQUIVALENCE  (FPCK(2) *  PACK ( 1 >  > 


ODATA 

1 

2 


<F0RM< I )*I=1*6)/1H,*1H/*1H9,1HX*1H**1H*/* 
FPCK(1)/10H(9X*  "/ * IBLNK/1H  /, IN/ll/*LP/6/* 

TERM/2H* )/*UTXT/12/ 


NMSG=0 

CALL  OPENMS(UTXT *NDEX,30*0) 

100  NMSG=NMSG+1 

IF(NMSG.LE.29)  GO  TO  120 
CALL  CLOSMS(UTXT) 

STOP 
120  M=0 

DO  HO  1  =  1*1900 
HO  TEXT(I)=IBLNK 
DO  150  1=1*190 
150  PACK(I)=IBLNK 
NLIN=0 

160  NLIN=NLIN+1 
DO  180  1=1,80 
180  LINE(I)=IBLNK 

READ(IN,1090)  LINE 
DO  200  1=1,80 
J=81-I 

IF (LINE ( J) .NE . IBLNK)  GO  TO  210 
200  CONTINUE 
J=0 

210  CONTINUE 

IF( J.LE.70)  GO  TO  220 
WRITE(LP,1100)  LINE 
STOP 

220  IF(J.GT.O)  GO  TO  230 
IF(M.GT.O)  GO  TO  270 
WRITE(LP*1110) 

STOP 

230  IF(NLIN.LE.25)  GO  TO  240 
WRITE(LP* 1120) 

STOP 

240  DO  250  1=1 rJ 
M=M+1 

250  TEXT(M)=LINE(I) 

DO  260  1=1*6 
M=M+1 

260  TEXT(M)=FORM(I ) 

GO  TO  160 

270  ?NCo!e<M,1130*PACK(1)>  (TEXT(I),I*1,N) 
WRITE(LP, 1140)  NMSG 
J=M+9 
J=J/10 
I=J+i 

PACK(I)=TERM 
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yRITE<LP»FPCK) 

CALL  yRITMS(UTXT.PACK.J.NMSG) 

GO  TO  100 
C 

1090  FORMAT  (80A1) 

1100  FORMAT  < 15H  LINE  OVERFLOW: r 80A1 ) 
1110  FORMAT  <14H  BLANK  MESSAGE) 

1120  FORMAT  <15H  TOO  MANY  LINES) 

1130  FORMAT  (1900A1) 

1140  FORMAT  (//1X.8HMESSAGE  .12//) 

END 


READY 


Section  7.3  contains  listings  of  the  programs  used  to  obtain  displays  of 
the  message  text  files  created  by  the  programs  listed  in  Section  7.2. 
Three  versions  are  provided,  one  for  field  text,  one  for  scenario  text  and 
one  for  model  text. 


The  original  version  of  the  program  was  written  to  process  coded  field  text 
messages  and  to  provide  as  output  a  file  of  message  data.  The  output  file 
can  either  be  printed  for  display  or  edited  and  re-entered  into  the  file 
build  program  for  updating  in  batch  mode.  Complete  details  are  contained 
in  comments  in  the  program  listing. 

The  program  used  to  display  scenario  messages  is  nearly,  but  not  quite, 
identical  to  that  used  for  field  text  messages.  Displays  appropriate  for 
data  field  items,  but  not  scenarios,  were  not  changed. 

The  file  containing  model  text  data  is  displayed  using  a  very  simplified 
version  of  the  program,  with  output  directly  to  the  terminal. 

Note  that  the  maximum  message  lengths,  number  of  messages,  format  control 
characters,  and  related  message  attributes  are  different  among  these  three 
programs  and  the  files  they  process. 
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7.3.1  Field  Text  (File  RGPMSG) 

PROGRAM  DISPLAY < OUTPUT. TAPE6=0UTPUT.TAPE10,TAPE11»TAPE1?) 

PROGRAM  WRITES  A  DISPLAY  OF  THE  HACS  FIELD  TEXT  MESSAGE 
FILE  (TAPE  11)  TO  AN  OUTPUT  FILE  (TAPE  12)  IN  BATCH  UPDATE 
FORMAT.  THE  CONTENTS  OF  THE  OUTPUT  FILE  CAN  THEN  BE  PRINTED 
USING  A  SYSTEM  UTILITY.  OR  CAN  BE  EDITED  (ALSO  BY  A  SYSTFM 
UTILITY).  THE  OUTPUT  FILE  IS  FORMATTED  SO  THAT  AFTER  EDITING 
IT  CAN  BE  PROCESSED  BY  THE  MESSAGE  UPDATE  PROGRAM  IN  BATCH 
MODE  TO  PRODUCE  AN  UPDATED  MESSAGE  FILE.  REFER  TO  THE  MESSAGE 
UPDATE  PROGRAM  LISTING  FOR  A  DESCRIPTION  OF  THE  MESSAGE  CODES 
AND  MESSAGE  FILE  FORMAT. 

THE  HACS  DEFAULT  FILE  IS  READ  BY  THIS  PROGRAM  TO  OBTAIN 
FIELD  NUMBERS.  NAMES  AND  VARIABLE  TYPES  FOR  USE  IN  DISPLAYS 
AND  TO  CORRELATE  THE  SEQUENTIAL  MESSAGE  NUMBERS  (FROM  1  TO  256) 
WITH  FIELD  POSITIONS  IN  THE  DEFAULT  FILE.  IF  THE  MESSAGE  FILE 
IS  NOT  FULL.  THAT  IS.  CONTAINS  LESS  THAN  256  MESSAGES.  THIS 
PROGRAM  WILL  TERMINATE  WITH  AN  MS  FILE  READ  ERROR. 

CODED  MESSAGES  WRITTEN  BY  THIS  PROGRAM  ARE  GENERATED  BY 
READING  TEXT  FROM  THE  MESSAGE  FILE.  APPENDING  APPROPRIATE 
FORTRAN  FORMAT  CODES  TO  THE  MESSAGE  STORED  AS  AN  ARRAY.  THEN 
USING  THE  ARRAY  AS  AN  EXECUTION  TIME  FORMAT. 


DEFLT  =  EXTERNAL  HACS  DEFAULT  FILE.  READ  TO  OBTAIN  HACS 

FIELD  NUMBER.  FIELD  NAME  AND  FIELD  TYPE  (INTEGER 
OR  REAL)  CORRESPONDING  TO  SEQUENTIAL  FIELD 
MESSAGE  NUMBERS. 

FPCK  =  ARRAY  EQUIVALENCED  TO  UNCODED.  PACKED  MESSAGE  TEXT 
AND  CONTAINING  STANDARD  FORMAT  CODE  IN  FIRST  WORD 
FVAL  =  ARRAY  OF  DEFAULT  VALUES  FOR  REAL  FIELDS.  READ  FROM 
DEFAULT  FILE  BUT  NOT  USED  IN  THIS  PROGRAM 
I  =  INDEX  ON  MESSAGE  NUMBER  FROM  1  TO  NFLD 

IVAL  =  ARRAY  OF  DEFAULT  VALUES  FOR  INTEGER  FIELDS.  READ  FROH 

DEFAULT  FILE  BUT  NOT  USED  IN  THIS  PROGRAM 
IVAR  =  CODED  FIELD  TYPE  INDICATOR  PACKED  IN  ARRAY  LIST  FOR 

EACH  HACS  DATA  FIELD  ( 0=INTEGER  FIELD.  1=REAL  FIELD) 

J  =  GENERAL  SUBSCRIPT  INDEX 

LIST  =  ARRAY  OF  CODES  IN  HACS  DEFAULT  FILE  DEFINING  THE 

STRUCTURE  OF  DATA  FIELD  ITEM  I  AS  LIST(I.J)  WHERE 
J=1 .6.  REFER  TO  HACS  PROGRAM  DOCUMENTATION  FOR 
COMPLETE  DETAILS. 

MNF  =  MAXIMUM  NUMBER  OF  REAL  FIELD  ITEMS  ALLOWED  IN  HACS 
DEFAULT  FILE 

MNI  =  MAXIMUM  NUMBER  OF  INTEGER  FIELD  ITEMS  ALLOWED  IN  HACS 
DEFAULT  FILE 

MOD  =  DATA  ARRAY  USED  TO  DISPLAY  FIELD  TYPE  LABELS 
MSG  =  TEXT  LABEL  STORED  AS  PART  OF  DEFAULT  FILE 

NDEX  =  FILE  TABLE  USED  BY  MASS  STORAGE  ROUTINES.  DIMENSIONED 

TO  NUMBER  OF  TEXT  MESSAGES  +  1 
NF  =  ACTUAL  NUMBER  OF  REAL  DATA  ITEMS  CONTAINED  IN  HACS 
DEFAULT  FILE 

NFLD  =  TOTAL  NUMBER  OF  DATA  FIELDS  STORED  IN  HACS  DEFAULT 
FILE  ( =NF+NI ) »  DEFINITIONS  OF  EACH  MESSAGE  ARE 
STORED  SEQUENTIALLY  IN  ARRAY  LIST. 

NI  =  ACTUAL  NUMBER  OF  INTEGER  DATA  ITEMS  CONTAINED  IN  HACS 
DEFAULT  FILE 

NW  =  LENGTH  OF  LAST  RECORD.  IN  WORDS.  READ  FROM 
MESSAGE  FILE 

ONE  =  DATA  WORD  CONTAINING  TAG  FOR  CODED  MESSAGES.  TYPE  1 

OUT  =  UNIT  DEVICE  NUMBER  FOR  OUTPUT  FILE  CREATED  BY  THIS 

PROGRAM 

PACK  =  ARRAY  CONTAINING  PACKED  MESSAGE  TEXT  DATA  READ  FROM 
MS  FILE.  MAXIMUM  RECORD  LENGTH  OF  6?.  DIMENSIONED 
AS  70  WORD  ARRAY  TO  ALLOW  FORMAT  CODE  TO  BE  ADDED 
AFTER  TEXT. 
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THR 

TWO 

UDFLT  = 
UTXT  = 

AUTHOR  - 


=  SPECIAL  FORMAT  TAB  FOR  TYPE  3  MESSAGES,  CREATES 
DISPLAY  IN  UPDATE  FORMAT  WITH  CODE  3  IN  FIRST 
POSITION  FIRST  CHARACTER  OF  MESSAGE  TEXT  IN 
SECOND  POSITION 

=  DATA  WORD  CONTAINING  CHARACTERS  TCI  CLOSE  MESSAGE 
IN  PACK  FOR  USE  AS  EXECUTION  TINE  FORMAT. 

=  DATA  WORD  CONTAINING  TAG  FOR  CODED  MESSAGES*  TYPE 
=  DATA  WORD  CONTAINING  TAG  FOR  CODED  MESSAGES*  TYPE 
=  UNIT  DEVICE  NUMBER  FOR  EXTERNAL  HACS  DEFAULT  FILE 
=  UNIT  DEVICE  NUMBER  FOR  EXTERNAL  MS  HESSAGE  TEXT  FILE 

-  R.G.  POTTS 

ARTHUR  D.  LITTLE*  INC. 

35/318A  ACORN  PARK 
CAMBRIDGE.  MASS.  02140 
TEL.  617-864-5770*  EXT.  2813 

-  20  AUGUST  1980 


OCOMMON/BASE/MSG ( 10 ) . MNF . MN I  *  NF . NI . L 1ST  C 275  *  6 ) . 
1  FVALC225.3) .IVALC50.3) 

REAL  MSG 

DIMENSION  DEFLTC2489) 

EQUIVALENCE  (DEFLT ( 1 ) *  MSG  < 1 ) ) 


DIMENSION  FPCKC71 ) .MOD (2, 2) >NDEX(?57) , PACK (70) 

INTEGER  FPCK. ONE .OUT .PACK* STRT. TERM *THR, TWO. UDFLT. UTXT 
EQUIVALENCE  (FPCKC2) .PACK(l) ) 

ODATA  FPCK(1)/10H(5X*  * / *KOB( 1*1 ?/4HINTE/> 

1  M0D(1*2)/3HGER/*M0D<2*1)/ 4HREAL/. M0DC2, 2//1H  /* 

2  0NE/1H1/.0UT/12/* STRT/10HC5X*  ’3/fTERh/2H* )/. 

3  THR/1H3/. TWO/ IH2/.UDFLT/10/. UTXT/ 1 1/ 


-—READ  EXTERNAL  DEFAULT  FILE  CONTAINING  FIELD  NUMBERS  AND 

NAMES  INDEXED  SEQUENTIALLY.  TOTAL  NUMBER  OF  FIELDS  ON  FILE 
IS  SUM  OF  REAL  AND  INTEGER  FIELDS. 

REWIND  UDFLT 
READ(UDFLT)  DEFLT 
NFLD=NF+NI 


- WRITE  INITIAL  MESSAGE  WITH  STARTING  MESSAGE  NUMBER  FOR 

USE  IN  BATCH  UPDATE 
WRITECOUT  *  1000 ) 


- OPEN  MASS  STORAGE  MESSAGE  FILE.  INDEXED  BY  MESSAGE  NUMBER. 

AND  START  LOOP  ON  MESSAGES  FROM  1  TO  NFLD 
CALL  OPENMSCUTXT *NDEX* 257.0) 

DO  40  1=1 .NFLD 


- DISPLAY  MESSAGE  NUMBER  TOGETHER.  WITH  HACS  FIELD  MODE.  NUMBER 

AND  NAME. 

IVAR=LIST(I.2)/1000 

IVAR=IVAR+1 

WRITECOUT. 1010)  I . CMODC IVAR. J) . J=1 .2) .LISTC I .1) . (LIST ( I . J) . J--3.5) 


-—READ  AND  DECODE  MESSAGE  I 
CALL  READMSCUTXT .PACK. 69. I) 
NW=LENGTHCUTXT) 

IF < PACK ( 1 ) .EQ.ONE)  GO  TO  10 
IFCPACK(i) .EQ.TWO)  GO  TO  10 
NW=NW+1 
PACK<NW)=TERM 

IFCPACKC 1 ) .EQ. THR)  GO  TO  20 


——OUTPUT  UNCODED  MESSAGE 
WRITECOUT, FPCK) 

GO  TO  30 


-WRITE  CODED  MESSAGES,  TYPES  1  AND  2 
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10  URITE(0UT r 1020 >  PACKU) 
GO  TO  30 


. WRITE  CODED  MESSAGE*  TYPE  3*  IN  UPDATE  FORMAT 

20  PACK(1 >=STRT 
WRITE<OUT*PACK) 


C- . -WRITE  MESSAGE  DELIMITER*  THEN  CONTINUE  LOOP  FOR  ALL  MESSAGES. 

30  WRITE(OUT*1030) 

40  CONTINUE 
STOP 
C 

1000  FORMAT  (42H000  -  NUMBER  OF  LAST  MESSAGE  ON  PRIOR  FILE) 
10100F0RMAT  <I3*21H  =  MESSAGE  INDEX  FOR  *A4*A3*7H  FIELD  *I4*2X*3A4* 

1  1SH*  MESSAGE  TEXT  < ) 

1020  FORMAT  (5X*A1) 

1030  FORMAT  (SX) 

END 

READY. 
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7.3.2  Scenario  Text  (File  RPSMSG) 


PROGRAM  DISPLAY (OUTPUT, TAPE6=QUTPUT»TAPE10»TAPEil  .TAPF.12) 

PROGRAM  WRITES  A  DISPLAY  OF  THE  MACS  FIELD  TEXT  MESSAGE 
FILE  (TAPE  11)  TO  AN  OUTPUT  FILE  (TAPE  12)  IN  BATCH  UPDATE 
FORMAT.  THE  CONTENTS  OF  THE  OUTPUT  FILE  CAN  THEN  BE  PRINTED 
USING  A  SYSTEM  UTILITY.  OR  CAN  BE  EDITED  (ALSO  BY  A  SYSTEM 
UTILITY).  THE  OUTPUT  FILE  IS  FORMATTED  SO  THAT  AFTER  EDITING 
IT  CAN  BE  PROCESSED  BY  THE  MESSAGE  UPDATE  PROGRAM  IN  BATCH 
MODE  TO  PRODUCE  AN  UPDATED  MESSAGE  FILE.  REFER  TO  THE  MESSAGE 
UPDATE  PROGRAM  LISTING  FOR  A  DESCRIPTION  OF  THE  MESSAGE  CODES 
AND  MESSAGE  FILE  FORMAT. 

THE  HACS  DEFAULT  FILE  IS  READ  BY  THIS  PROGRAM  TO  OBTAIN 
FIELD  NUMBERS.  NAMES  AND  VARIABLE  TYPES  FOR  USE  IN  DISPLAYS 
AND  TO  CORRELATE  THE  SEQUENTIAL  MESSAGE  NUMBERS  (FROM  1  TO  256) 
WITH  FIELD  POSITIONS  IN  THE  DEFAULT  FILE.  IF  THE  MESSAGE  FILE 
IS  NOT  FULL.  THAT  IS.  CONTAINS  LESS  THAN  256  MESSAGES.  THIS 
PROGRAM  WILL  TERMINATE  WITH  AN  MS  FILE  READ  ERROR. 

CODED  MESSAGES  WRITTEN  BY  THIS  PROGRAM  ARE  GENERATED  BY 
READING  TEXT  FROM  THE  MESSAGE  FILE.  APPENDING  APPROPRIATE 
FORTRAN  FORMAT  CODES  TO  THE  MESSAGE  STORED  AS  AN  ARRAY,  THEN 
USING  THE  ARRAY  AS  AN  EXECUTION  TIME  FORMAT. 


DEFLT  =  EXTERNAL  HACS  DEFAULT  FILE.  READ  TO  OBTAIN  HACS 

FIELD  NUMBER,  FIELD  NAME  AND  FIELD  TYPE  (INTEGER 
OR  REAL)  CORRESPONDING  TO  SEQUENTIAL  FIELD 
MESSAGE  NUMBERS. 

FPCK  =  ARRAY  EQUIVALENCED  TO  UNCODED,  PACKED  MESSAGE  TEXT 
AND  CONTAINING  STANDARD  FORMAT  CODE  IN  FIRST  UORD 
FVAL  =  ARRAY  OF  DEFAULT  VALUES  FOR  REAL  FIELDS,  READ  FROM 
DEFAULT  FILE  BUT  NOT  USED  IN  THIS  PROGRAM 
I  =  INDEX  ON  MESSAGE  NUMBER  FROM  1  TO  NFLD 

IVAL  =  ARRAY  OF  DEFAULT  VALUES  FOR  INTEGER  FIELDS,  READ  FROM 

DEFAULT  FILE  BUT  NOT  USED  IN  THIS  PROGRAM 
IVAR  =  CODED  FIELD  TYPE  INDICATOR  PACKED  IN  ARRAY  LIST  FOR 

EACH  HACS  DATA  FIELD  (0=INTEGER  FIELD,  1=REAL  FIELD) 

J  =  GENERAL  SUBSCRIPT  INDEX 

LIST  =  ARRAY  OF  CODES  IN  HACS  DEFAULT  FILE  DEFINING  THE 

STRUCTURE  OF  DATA  FIELD  ITEM  I  AS  LIST(I.J)  WHERE 
J=l,6.  REFER  TO  HACS  PROGRAM  DOCUMENTATION  FOR 
COMPLETE  DETAILS. 

MNF  •  MAXIMUM  NUMBER  OF  REAL  FIELD  ITEMS  ALLOWED  IN  HACS 
DEFAULT  FILE 

MNI  =  MAXIMUM  NUMBER  OF  INTEGER  FIELD  ITEMS  ALLOWED  IN  HACS 
DEFAULT  FILE 

MOD  =  DATA  ARRAY  USED  TO  DISPLAY  FIELD  TYPE  LABELS 
MSG  =  TEXT  LABEL  STORED  AS  PART  OF  DEFAULT  FILE 

NDEX  =  FILE  TABLE  USED  BY  MASS  STORAGE  ROUTINES.  DIMENSIONED 

TO  NUMBER  OF  TEXT  MESSAGES  +  1 
NF  =  ACTUAL  NUMBER  OF  REAL  DATA  ITEMS  CONTAINED  IN  HACS 
DEFAULT  FILE 

NFLD  =  TOTAL  NUMBER  OF  DATA  FIELDS  STORED  IN  HACS  DEFAULT 
FILE  (=NF+NI ) .  DEFINITIONS  OF  EACH  MESSAGE  ARE 
STORED  SEQUENTIALLY  IN  ARRAY  LIST. 

NI  =  ACTUAL  NUMBER  OF  INTEGER  DATA  ITEMS  CONTAINED  IN  HACS 
DEFAULT  FILE 

NW  =  LENGTH  OF  LAST  RECORD,  IN  WORDS,  READ  FROM 
MESSAGE  FILE 

ONE  *  DATA  WORD  CONTAINING  TAG  FOR  CODED  MESSAGES.  TYPE  1 

OUT  =  UNIT  DEVICE  NUMBER  FOR  OUTPUT  FILE  CREATED  BY  THIS 

PROGRAM 

PACK  =  ARRAY  CONTAINING  PACKED  MESSAGE  TEXT  DAT#.  READ  FROM 
MS  FILE,  MAXIMUM  RECORD  LENGTH  OF  69,  DIMENSIONED 
AS  70  WORD  ARRAY  TO  ALLOW  FORMAT  CODE  TO  BE  ADDEO 
AFTER  TEXT. 
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STRT 


TERM 

THR 

TWO 

UDFLT 

UTXT 


SPECIAL  FORMAT  TAG  FOR  TYPE  3  MESSAGES,  CREATES 
DISPLAY  IN  UPDATE  FORMAT  WITH  CODE  3  IN  FIRST 
POSITION*  FIRST  CHARACTER  OF  MESSAGE  TEXT  IN 
SECOND  POSITION 

DATA  WORD  CONTAINING  CHARACTERS  TO  CLOSE  MESSAGE 
IN  PACK  FOR  USE  AS  EXECUTION  TIME  FORMAT, 

DATA  UORD  CONTAINING  TAG  FOR  CODED  MESSAGES*  TYPE  3 
DATA  UORD  CONTAINING  TAG  FOR  CODED  MESSAGES*  TYPE  2 
UNIT  DEVICE  NUMBER  FOR  EXTERNAL  HACS  DEFAULT  FILE 
UNIT  DEVICE  NUMBER  FOR  EXTERNAL  MS  MESSAGE  TEXT  FILE 


AUTHOR  -  R.G.  POTTS 

ARTHUR  D,  LITTLE.  INC. 

35/318A  ACORN  PARK 
CAMBRIDGE*  MASS.  02140 
TEL.  617-864-5770.  EXT.  2813 

DATE  -  20  AUGUST  1980 


OCOMMON/BASE/MSG ( 10 ) , MNF , MNI , NF , NI , LIST ( 275 , 6 ) , 
1  FVAL(225,3),IVAL(50,3> 

REAL  MSG 

DIMENSION  DEFLT  <2489) 

EQUIVALENCE  (DEFLT ( 1 ) r MSG ( 1 ) ) 


DIMENSION  FPCM71 ) . MOD ( 2*2)  >NDEX(257)  *PACK(70) 

INTEGER  FPCK. ONE, OUT  *  PACK .STRT* TERM.THR .TWO. UDFLT, UTXT 

EQUIVALENCE  (FPCK<2) , PACK < 1) ) 


ODATA 
1 
2 
3 


FPCK(1)/10H(9X,  * / , MOD (1,1)/4HINT£/, 

M0Dd*2)/3HGER/,M0D(2,l>/4HREAL/,M0B(2,2)/lH  /, 
ONE/1  HI/, OUT/12/, STRT/10H(5X,  ^/.TFRH/SH' 5 /, 
THR/1H3/*TUO/1H2/,UDFLT/10/,UTXT/11/ 


. READ  EXTERNAL  DEFAULT  FILE  CONTAINING  FIELD  NUMBERS  AND 

NAMES  INDEXED  SEQUENTIALLY.  TOTAL  NUMBER  OF  FIELDS  ON  FILE 
IS  SUM  OF  REAL  AND  INTEGER  FIELDS. 

REWIND  UDFLT 

KUVW  0EFlT 

. WRITE  INITIAL  MESSAGE  WITH  STARTING  MESSAGE  NUMBER  FOR 

USE  IN  BATCH  UPDATE 
URITE(OUT * 1000) 

. —OPEN  MASS  STORAGE  MESSAGE  FILE,  INDEXED  BY  MESSAGE  NUMBER, 

AND  START  LOOP  ON  MESSAGES  FROM  1  TO  NFLD 
CALL  OPENMSCUTXT ,NDEX,31»0> 

DO  40  1=1, NFLD 

— . DISPLAY  MESSAGE  NUMBER  TOGETHER  WITH  HACS  FIELD  MODE,  NUMBER 

AND  NAME. 

IVAR=LIST ( I *2)/1000 
IVAR=IVAR+1 

WRITE(OUT ,1010)  1 , <MOP( IVAR, J) , J=1 ,2) , LIST (1,1), (LIST (I.J) , J=3,5) 
C 

C . READ  AND  DECODE  MESSAGE  I 

CALL  READMS(UTXT, PACK, 69*1) 

NW=LENGTH(UTXT) 

I F ( PACK ( 1 ) .EQ .ONE)  GO  TO  10 
IF(PACK(1) .EQ.TWO)  GO  TO  10 
NW=NW+1 
PACK(NW)=TERM 

IF(PACKd).EQ.THR)  GO  TO  20 
C 

C . OUTPUT  UNCODED  MESSAGE 

WRITE(OUT.FPCK) 

GO  TO  30 
C 

C . WRITE  CODED  MESSAGES,  TYPES  1  AND  2 
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10  WRITE(0UT * 1020)  PACK(l) 
60  TO  30 


- WRITE  CODED  MESSAGE *  TYPE  3,  IN  UPDATE  FORMAT 

20  PACK(1)=STRT 
WRITE(OUTtPACK) 


C - WRITE  MESSAGE  DELIMITER*  THEN  CONTINUE  LOOP  FOR  ALL  MESSAGES. 

30  WRITE(0UT*1030) 

40  CONTINUE 
STOP 
C 

1000  FORMAT  (42HOOO  =  NUMBER  OF  LAST  MESSAGE  ON  PRIOR  FILE) 
10100FORHAT  ( I3r 21H  =  MESSAGE  INDEX  FOR  »A4,A3,7H  FIELD  »I4*2X*3A4, 

1  15H,  MESSAGE  TEXT* ) 

1020  FORMAT  <5X,A1> 

1030  FORMAT  <5X) 

END 

READY. 
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7.3.3  Model  Text  (File  RGPEDT) 


PROGRAM  DISPLAY ( OUTPUT »TAPE6s;0UTPUT  »TAPE12) 

DIMENSION  FPCK < 192) r NDEX ( 30 ) *  PACK (191) 

INTEGER  FPCK » PACK » TERM »UTXT 
EQUIVALENCE  (FPCK<2) r PACK( 1 ) > 

DATA  FPCK<  1  )/10H(9Xi  VfUTXT/^/.LP/i/jTERH/^H*  >/ 
CALL  OPENMS(UTXTfNDEX>30»0) 

DO  40  I*lr29 

CALL  READMS(UTXT»PACKi 1 90 » I ) 

NW=LENGTH(UTXT) 

NW*NW+1 
PACK(NW)=TERM 
MRITE(LP»1000)  I 

1000  FORMAT  <//lX> 'MESSAGE  '.12//) 

WRITE(LP»FPCK) 

40  CONTINUE 
STOP 
END 

READY. 
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7.4  Utilities 


Listings  of  two  utility  programs  used  for  different  purposes  in  the 
HACS/UIM  development  are  given  in  Sections  7.4.1  and  7.4.2. 

Section  7.4.1  contains  descriptions  and  listings  of  21  different  sub¬ 
routines  that  together  form  a  data  compression  utility  package.  The 
routines  are  used  to  pack  (set)  or  unpack  (read)  numeric  code  values 
utilizing  individual  bits  within  memory  words  with  a  set  of  Fortran 
callable  subroutines.  Some  of  these  routines  have  been  incorporated 
within  HACS/UIM.  The  complete  package  of  code  manipulation  routines  is 
very  general,  and  should  be  readily  adaptable  to  other  applications 
requiring  data  compression. 

Three  levels  of  coding  capability  are  provided: 

(1)  Storing  a  string  of  single  bit  codes  within  a  single  memory  word, 

(2)  Storing  a  string  of  single  bit  codes  within  an  array  of  memory 
words,  and, 

(3)  Storing  a  string  of  multiple  bit  codes  within  an  array  of  memory 
words . 

Within  each  level,  the  same  functional  procedures  are  provided  for 
initialization,  set,  reset,  test,  pack  and  unpack  operations.  The  set, 
reset  and  test  features  operate  randomly  on  code  N  within  a  collection  of 
coded  values  1  to  M.  The  pack  and  unpack  features  operate  sequentially  on 
all  coded  values,  1  to  M,  providing  for  bulk  transfer  of  coded  information. 
Detailed  documentation  of  this  utility  package  is  given  in  Section  7.4.1. 

In  Section  7.4.2,  a  listing  is  given  of  a  short  utility  program  that  was 
written  to  translate  tab  key  entries  (ASCII  code)  to  corresponding  control 
of  stored  file  data  (BCD  code).  Source  files  entered  with  an  ASCII 
terminal  contains  lines  of  text  in  which  the  tab  character  may  appear.  In 
BCD  mode,  the  ASCII  tab  is  treated  as  any  other  character,  and  the  source 
data  line  is  unaffected.  The  version  of  the  program  given  in  Section  7.4.2 
was  used  to  process  files  containing  Fortran  source  code  with  tab  control 
entered  to  start  comment  line  text  in  column  10,  and  source  statement  text 
in  column  7. 

The  program  reads  each  line  of  the  input  file,  tests  for  the  appearance  of 
tab  characters,  and  inserts  spaces  in  the  text  as  indicated.  Both  the 
input  and  output  files  are  on  disk;  the  output  disk  file  can  be  listed  after 
the  program  run  to  verify  the  desired  tab  spacing.  Note  that  this  program 
can  readily  be  modified  or  adapted  for  processing  similar  data  input 
formats  to  simplify  keying  operations. 
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7.4.1  Data  Compression  (File  SAVCOD) 


mtmtm**mm*mt******mmm*mm*m*mmmm 

*  * 

*  DATA  COMPRESSION  UTILITY  PACKAGE  * 

*  * 

mmmmmmmmmttmunttittmttmtmtmumt 

THE  DATA  COMPRESSION  UTILITY  PACKAGE  IS  COMPRISED  OF  A  SERIES 
OF  SUBROUTINES  AND  FUNCTIONS  USED  TO  PACK  OR  UNPACK  NUHERIC 
CODE  VALUES  UTILIZING  INDIVIDUAL  BITS  WITHIN  MEMORY  WORDS. 

THREE  LEVELS  OF  CAPABILITY  ARE  PROVIDED  - 

(1)  STORING  A  STRING  OF  SINGLF  BIT  CODES  WITHIN  A 

SINGLE  MEMORY  WORD » 

(2)  STORING  A  STRING  OF  SINGLE  BIT  CODES  WITHIN  AN 

ARRAY  OF  MEMORY  WORDS,  AND, 

(3)  STORING  A  STRING  OF  MULTIPLE  BIT  CODES  WITHIN  AN 

ARRAY  OF  MEMORY  WORDS. 

WITHIN  EACH  LEVEL,  THE  SAME  FUNCTIONAL  PROCEDURES  ARE  PROVIDED 
FOR  INITIALIZATION,  SET,  RESET,  TEST,  PACK  AND  UNPACK  CODES. 

THE  SET,  RESET  AND  TEST  FEATURES  OPERATE  RANDOMLY  ON  CODE  N 
WITHIN  A  COLLECTION  OF  CODED  VALUES  1  TO  M,  THE  PACK  AND 
UNPACK  FEATURES  OPERATE  SEQUENTIALLY  ON  ALL  CODED  VALUES,  1  TO 
M,  PROVIDING  FOR  BULK  TRANSFER  OF  CODED  INFORMATION. 

AUTHOR  -  R.G.  POTTS,  ARTHUR  D.  LITTLE,  INC., 

35/318A  ACORN  PARK, 

CAMBRIDGE,  MASS.,  02140 
TEL.  617-864-5770  EXT.  2813 
DATE  -  17  NOVEMBER  1980 


LEVEL  (3)  ROUTINES  = 

SUBROUTINE  INIT(CODE,I,J,K) 

LOGICAL  FUNCTION  ECHK(N) 

SUBROUTINE  SET(CODE,N,IVAL) 

SUBROUTINE  RSET(CODE,N) 

FUNCTION  ITSTICODE »N) 

SUBROUTINE  PACK(IAR,CODE> 

SUBROUTINE  UNPK<CODE,IAR> 

LEVEL  (2)  ROUTINES  = 

SUBROUTINE  INITM(CODE,I, J) 

LOGICAL  FUNCTION  ECHKM(N) 

SUBROUTINE  SETM(CODE,N> 

SUBROUTINE  RSETM(CODE,N) 

FUNCTION  ITSTM(CODE,N) 

SUBROUTINE  PACKMI IAR,COOE ) 

SUBROUTINE  UNPKMICODE, IAR> 

LEVEL  (1)  ROUTINES  = 

SUBROUTINE  INIT1 (CODE, I ) 

LOGICAL  FUNCTION  ECHKKN) 

SUBROUTINE  SET1(C0DE,N) 

SUBROUTINE  RSET1(C0DE,N> 

FUNCTION  ITST1 (CODE,N) 

SUBROUTINE  PACK1( IAR,CODE) 

SUBROUTINE  UNPK1(C0DE,IAR) 

FUNCTIONS  ECHK,  ECHKM  AND  ECHK1  ARE  ONLY  CALLED  BY  OTHER  BIT 
MANIPULATION  ROUTINES  AND  ARE  NOT  USED  IN  THE  CALLING  PROGRAM. 
REMAINING  ROUTINES  ARE  USER  CALLABLE  AND  ARGUMENT  DEFINITIONS 
ARE  GIVEN  BELOW  - 
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CODE  =  SINGLE  WORD  (LEVEL  1)  OR  INTEGER  ARRAY  (LEVELS  2  AND 
3)  FOR  STORAGE  OF  PACKED  CODED  VALUES  AT  CPW 
CODED  VALUES  PER  WORD,  LEVELS  1  AND  2  USE  SINGLE 
BIT  CODED  VALUES  (0  OR  I).  LEVEL  3  ROUTINES  ASSUME 
MULTIPLE  BIT  CODED  VALUES  WITHIN  A  FIXED  BYTE  SIZE 
OF  CDLN. 

I  =  INPUT  TO  INITIALIZATION  ROUTINE  SPECIFYING  THE 

MAXIMUM  NUMBER  OF  BITS  IN  EACH  WORD  OF  CODE  WHICH 
CAN  BE  USED  FOR  STORAGE  OF  CODED  VALUES. 

IAR  =  INTEGER  ARRAY  CONTAINING  UNPACKED  CODED  VALUES 
TO  BE  MOVED  TO  CODE  (PACK  OPERATION)  OR  TO  BE 
RECEIVED  FROM  CODE  (UNPACK  OPERATION)  IN  SEQUENTIAL 
DATA  TRANSFER. 

IVAL  =  NUMERIC  EQUIVALENT  OF  CODE  VALUE  TO  BE  PACKED  IN 
CODE  POSITION  N  BY  SUBROUTINE  SET. 

J  =  MAXIMUM  NUMBER  OF  WORDS  IN  ARRAY  CODE  WHICH  ARE 

USED  FOR  STORAGE  OF  CODED  VALUES.  BY  DEFINITION, 
THIS  ARGUMENT  APPLIES  ONLY  TO  LEVEL  2  AND  3  ROUTINES 
AND  A  VALUE  OF  1  IS  USFD  FOR  THE  LEVEL  1  ROUTINES. 

K  =  DEFINES  THE  STORAGE  REQUIRED  FOR  A  SINGLE  CODED 
VALUE  FOR  LEVEL  3  ROUTINES  AT  K  BITS  PER  CODE, 

K  BEING  THE  LARGEST  BYTE  REQUIRED  TO  CONTAIN  THE 
LARGEST  CODED  VALUE.  THIS  DETERMINES  THE  ALLOWED 
INTEGER  MAGNITUDE  OF  EACH  CODED  VALUE  TO  BE  GREATER 
THAN  OR  EQUAL  TO  ZERO,  AND  LESS  THAN  2**K,  LEVEL 
1  AND  2  ROUTINES  USE  SINGLE  BIT  CODING  SO  A  VALUE 
OF  1  IS  ASSUMED  FOR  K. 

N  =  CODED  VALUE  INDEX  NUMBER,  VARIES  FROM  1  TO  MAXIMUM 

NUMBER  OF  CODED  VALUES  IMPLIED  BY  I,J,K. 

THE  ARRAY  IAR  AND  THE  ARRAY  CODE  (EXCEPT  FOR  LEVEL  1)  MUST  BE 
DIMENSIONED  IN  THE  CALLING  PROGRAM  ACCORDING  TO  THE  LENGTHS 
IMPLIED  BY  I,  J  AND  K. 

THE  INITIALIZATION  ROUTINES  (INIT,  INITM  AND  INIT1)  SPECIFY 
THE  CHARACTERISTICS  OF  THE  COMPRESSED  DATA  STORAGE.  THE 
APPROPRIATE  INITIALIZATION  ROUTINE  MUST  BE  CALLED  ONCE  BEFORE 
ANY  REFERENCE  TO  A  CODED  VALUE  BY  ANY  OF  THE  SET,  RESET  OR 
TEST  ROUTINES,  AND  AGAIN  ON  RE-DEFINITION  OF  THE  CODE  WORD 
OR  ARRAY  OR  ITS  STORAGE  CHARACTERISTICS.  THE  INITIALIZATION 
ROUTINES  MUST  ALSO  BE  CALLED  IMMEDIATELY  BEFORE  EACH  CALL  TO 
ONE  OF  THE  PACK  OR  UNPACK  ROUTINES  (REFER  TO  LISTINGS  OF  SUB¬ 
ROUTINES  PACK  AND  UNPK  FOR  ADDITIONAL  INFORMATION).  THE 
INITIALIZATION  PRE-SETS  VALUES  IN  LABELLED  COMMON  WHICH  ARE 
USED  BY  THE  OTHER  MANIPULATION  ROUTINES.  DEFINITIONS  OF  ALL 
VARIABLES  IN  COMMON  USED  BY  THESE  ROUTINES  FOLLOW  - 

CDLN  =  INTEGER  VALUE  GIVING  LENGTH  OF  SINGLE  CODED  VALUE 
IN  BITS,  DETERMINED  FROM  VALUE  OF  K  (SEE  ABOVE) 

CPW  =  MAXIMUM  NUMBER  OF  CODED  VALUES  WHICH  CAN  BE  STORED 
IN  A  SINGLE  WORD  (CODE) 

IERR  =  INTEGER  ERROR  FLAG  RETURNED  IN  COMMON  AS  ZERO  FOR 

NO  ERROR,  OR  A  VALUE  IN  THE  RANGE  1  TO  ?.  IF  MORE 
THAN  ONE  ERROR  CAN  OCCUR,  ONLY  THE  LAST  VALUE  IS 
INDICATED.  SPECIFIC  ERROR  CODES  ARE  DEFINED  BELOW. 
ITMP  =  INTEGER  WORD  LOCATION  USED  AS  SCRATCH  SPACE  FOR 
MANIPULATION  ROUTINES. 

L  =  INDEX  TO  WORD  OF  ARRAY  CODE  CONTAINING  CODED  VALUE  N 

(ASSUMED  TO  BE  1  FOR  LEVEL  1  USE).  „ 

MAXN  =  MAXIMUM  NUMBER  OF  CODED  VALUES  AS  DETERMINED  DURING 
INITIALIZATION  (REPLACED  BY  CPW  IN  LEVEL  1)  , 

MAXV  =  MAXIMUM  VALUE  OF  A  SINGLE  CODE  VALUE  FOR  LEVEL  3 
(=1  FOR  LEVELS  1  AND  2). 

SHFT  *  INTEGER  FACTOR  USED  FOR  POSITIONING  SINGLE  CODE  VALUE 
RELATIVE  TO  PACKED  CODE  WORD. 

COMMON  VARIABLES  ARE  STORED  IN  THE  LABELLED  COMMON  BLOCK 
NAMED  GCODE,  AND  DIFFERENT  LENGTHS  ARE  DEFINED  FOR  EACH  GROUP 
OF  MANIPULATION  ROUTINES  (ONLY  REQUIRED  VARIABLES  ARE  LISTED). 
HOWEVER  ALL  DEFINITIONS  OF  /GCODE/  ARE  COMPATIBLE.  FOR  USER 
TESTING  OF  ERROR  CONDITIONS,  THE  COMMON  AREA  MUST  ALSO  BE 
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DEFINED  IN  THE  CALLING  PROGRAM  USING  COMMON/GCODE/IERR  WHERE 
IERR  MAY  PE  ANY  INTEGER  VARIABLE*  AFTER  CALLING  A  MANIPULATION 
ROUTINE ?  A  VALUE  OF  ZERO  INDICATES  NO  ERROR?  AND  A  NON-ZERO 
VALUE  INDICATES  ONE  OR  MORE  ERRORS  OCCURRED.  LEVEL  1  ROUTINES 
RETURN  ERROR  CODES  1-6?  LEVEL  2  RETURNS  1-7  AND  LEVEL  3  RETURNS 
1-9.  DEFINITIONS  OF  ALL  ERROR  CODES  FOLLOW  - 


0 

1 


3 

4 

5 

6 

7 

8 
9 


NO  ERROR  CONDITION  DETECTED. 

LENGTH  OF  WORD  IN  BITS  FOR  CODE  STORAGF  IS  ZERO  OR 
NEGATIVE 

LENGTH  OF  WORD  IN  BITS  REQUESTED  FOR  CODE  STORAGE 
EXCEEDS  MAXIMUM  WORD  LENGTH  SET  IN  SUBROUTINES 
INIT ?  INITM  AND  INIT1  AS  INSTALLATION  PARAMETER. 

REQUESTED  CODE  POSITION  N  HAS  A  VALUE  OF  ZERO  OR 
IS  NEGATIVE. 

REQUESTED  CODE  POSITION  N  EXCEEDS  THE  NUMBER  OF 
POSITIONS  DEFINED  FOR  COMPACTED  STORAGE. 

CODE  VALUE  REQUESTED  TO  BE  STORED  IS  NEGATIVE  (MUST 
BE  ZERO  OR  POSITIVE).  ZERO  IS  STORED. 

CODE  VALUE  REQUESTED  TO  BE  STORED  IS  GREATER  THAN 
MAXIMUM  VALUE  WHICH  CAN  BE  STORED  WITHIN  LENGTH 
OF  CODE  SPECIFIED.  MAXIMUM  VALUE  IS  STORED. 

NUMBER  OF  WORDS  REQUESTED  FOR  LENGTH  OF  ARRAY  CODE 
IS  NOT  GREATER  THAN  ZERO. 

NUMBER  OF  BITS  SPECIFIED  FOR  LENGTH  OF  SINGLE  CODE 
VALUE  IS  NOT  GREATER  THAN  ZERO. 

NUMBER  OF  BITS  SPECIFIED  FOR  LENGTH  OF  SINGLE  CODE 
VALUE  EXCEEDS  SPECIFIED  LENGTH  OF  CODE  WORD. 


PROGRAM  LISTINGS  OF  ALL  SUBROUTINES  AND  FUNCTIONS  FOLLOW. 

IN  GENERAL?  LEVEL  3  ROUTINES  MAY  BE  USED  TO  PERFORM  ALL 
OPERATIONS?  HOWEVER  FOR  APPROPRIATE  CODING  STRUCTURES?  LEVEL 
2  AND  1  ROUTINES  OFFER  SIMPLIFIED  EXECUTION  FOR  SIMPLIFIED 
CODING.  ADDITIONAL  NOTES  ON  USE  ARE  GIVEN  IN  INDIVIDUAL 
PROGRAM  LISTINGS. 

mmmmmm*m«mt*mmmtm*m****ttttt*«***m* 
%  % 

t  LEVEL  1  PROGRAM  LISTINGS  * 

*  * 


SUBROUTINE  INIT(CODE? I ? J?K) 

SUBROUTINE  INIT  INITIALIZES  THE  CODING  ROUTINES  TO  STORE  NEW 
CODES.  OR  TO  READ  PREVIOUSLY  STORED  CODES?  IN  THE  INTEGER 
ARRAY  CODE,  THE  ARRAY  CODE?  MUST  BE  DIMENSIONED  IN  THE 
CALLING  PROGRAM  TO  BE  OF  LENGTH  J  OR  GREATER.  THE  CHARACTER¬ 
ISTICS  OF  THE  STORED  NUMERIC  CODES  ARE  SPECIFIED  BY  THE 
REMAINING  ARGUMENTS  - 

I  =  MAXIMUM  NUMBER  OF  BITS  IN  EACH  WORD  OF  THE  ARRAY  CODE 

WHICH  CAN  BE  USED  FOR  STORAGE  OF  CODED  VALUES. 

J  =  MAXIMUM  NUMBER  OF  WORDS  IN  ARRAY  CODE  WHICH  ARE 

USED  FOR  STORAGE  OF  CODED  VALUES. 

K  =  DEFINES  THE  STORAGE  REQUIRED  FOR  A  SINGLE  CODED  VALUE 

TO  BE  FIXED  LENGTH  AT  K  BITS  PER  CODE.  THIS  DETER¬ 
MINES  THE  ALLOWED  INTEGER  MAGNITUDE  OF  EACH  CODED 
VALUE  TO  BE  GREATER  THAN  OR  EQUAL  TO  ZERO?  AND  LESS 
THAN  2**K. 

ON  RETURN?  THE  ERROR  FLAG  IERR  IN  COMMON  IS  ZERO  IF  NO  ERRORS 
WERE  ENCOUNTERED.  ERROR  CONDITIONS  WILL  CAUSE  IERR  TO  BE  SET 
TO  1?2?7?8  OR  9  ON  RETURN?  AND  CONTROL  VARIABLES  IN  COMMON 
TO  BE  SET  FOR  SINGLE  BIT?  SINGLE  WORD  CODE  STORAGE. 

SUBROUTINE  INIT  CONTAINS  A  SINGLE  INTERNAL  PARAMclER?  MXWRD. 
WHICH  DEFINES  THE  MAXIMUM  ALLOWED  UNSIGNED  INTEGER  WORD 
LENGTH  IN  BITS  AND  IS  INSTALLATION  DEPENDENT,  FOR  A  NORMAL 
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16-BIT  WORD  LENGTH*  MXWRD  SHOULD  BE  SET  TO  15.  FOR  USE  WITH 
DOUBLE  PRECISION  (TUO-WORD)  INTEGERS*  HXWRD  CAN  BE  SFT  TO  31 
FOR  A  16-BIT  WORD  LENGTH  IF  INTEGER  SPECIFICATIONS  ARE  ALSO 
MODIFIED  IN  THESE  ROUTINES,  FOR  USE  ON  THE  CDC  CYBERNET  NET¬ 
WORK*  INTEGER  ARITHMETIC  IS  LIMITED  TO  PARTIAL  WORDS*  SO  MXWRD 
IS  SET  TO  47  OUT  OF  60  BITS  AVAILABLE  IN  THE  FULL  WORD. 

SUBROUTINE  INIT  MUST  BE  CALLED  ONCE  AND  ONLY  ONCE  FOR  EACH 
CODED  ARRAY  PRIOR  TO  ALL  CALLS  USING  THE  ROUTINES  SET,  RSET 
OR  ITST  WITH  THE  CODED  ARRAY.  NOTE  THAT  INIT  WILL  CLEAR  THE 
CONTENTS  OF  THE  REFERENCED  CODED  ARRAY.  INIT  MUST  BE  CALLED 
IMMEDIATELY  BEFORE  EACH  CALL  TO  THE  BULK  TRANSFER  ROUTINES 
PACK  AND  UNPK. 

COMMON  VARIABLES  USED  -  CDLN*CPW*IERR*L*MAXN*MAXV 
SUBROUTINES  REQUIRED  -  NONE 


COMMON/GCODE/IERR *  CPW  *  I TMP *  SHFT *  L  *  MAXN *  CDLN*  MAXV 
INTEGER  CPW* CDLN* SHFT 


INTEGER 

DATA 


CODE ( 1 ) 
MXWRD/47/ 


- TEST  LENGTH  OF  WORD  TO  BE  USED  FOR  CODE  STORAGE.  CANNOT  BE 

LESS  THAN  1  OR  EXCEED  MAXIMUM  UNSIGNED  INTEGER  WORD  LENGTH, 
IF(I.LE.O)  GO  TO  20 
IF(I.GT. MXWRD)  GO  TO  30 


- TEST  NUMBER  OF  WORDS  TO  BE  USFD  FOR  CODE  STORAGE.  CANNOT  BE 

LESS  THAN  1.  UPPER  LIMIT  IS  NOT  TESTED  SINCE  THIS  IS 
CONTROLLED  BY  USER  DIMENSION  IN  CALLING  PROGRAM. 

IF(J.LE.O)  GO  TO  40 


- TEST  NUMBER  OF  BITS  TO  BE  USED  FOR  SINGLE  CODE.  CANNOT  BE 

LESS  THAN  1  OR  EXCEED  SPECIFIED  LENGTH  OF  CODE  WORD. 
IF(K.LE.O)  GO  TO  50 
IF(K.GT.I)  GO  TO  60 


. —NORMAL  RETURN.  COMPUTE  NUMBER  OF  CODES  TO  BE  STORED  PER 

WORD  (CPW)*  INITIALIZE  ALL  CODE  WORDS  TO  ZERO,  AND  SET  NORMAL 
ERROR  RETURN.  COMPUTE  TOTAL  NUMBER  OF  CODES  WHICH  CAN  BE 
STORED  (MAXN)*  MOVE  CODE  LENGTH  K  TO  COMMON  VARIABLE  CDLN* 

AND  COMPUTE  MAXIMUM  ALLOWED  CODE  VALUE  (MAXV). 

IERR=0 
CPW=I/K 
DO  10  L=1 * J 
10  C0DE(L)=0 
MAXN=CPW*J 
CDLN=K 

MAXV=2**CDLN-1 

RETURN 


. ERROR  RETURNS,  SET  VALUE  OF  ERROR  SWITCH  IN  COMMON  AND 

DEFAULT  TO  CODE  DEFINITION  USING  SINGLE  WORD  CONTAINING  CODES 
ONE  BIT  IN  LENGTH. 

20  IERR=1 
GO  TO  70 
30  IERR=2 
GO  TO  70 
40  IERR®7 
GO  TO  70 
50  IERR*8 
GO  TO  70 
60  IERR=9 
70  CPW*MXWRD 
CODE(1>»0 
MAXN*MXWRD 
CDLN»1 
MAXV*1 


237 


nnnnnnn  on  non  ooo  on  noon  nnnnnnnonnnnnnn  nnnnnnnnnnnn 


RETURN 

END 

LOGICAL  FUNCTION  ECHK(N) 

LOGICAL  FUNCTION  ECHK  (FOR  ERROR  CHECK)  TESTS  THE  REQUESTED 
CODE  POSITION  SPECIFIED  BY  THE  ARGUMENT  N.  IF  THE  POSITION 
IS  NOT  WITHIN  THE  ALLOWED  NUMBER  OF  CODED  VALUES  (1  TO  HAXN)* 
THE  ERROR  INDICATOR  IERR  IN  COMMON  IS  SET  TO  3  OR  4  AND  THE 


®MEm.fErUE  0F  -TRUE' 


ALL  OTHER  VARIABLES  IN 


IF  THE  SPECIFIED  CODE  POSITION*  Nr  IS  VALID*  THE  ERROR  CHECK 
FUNCTION  RETURNS  A  VALUE  OF  .FALSE.  AND  SETS  VARIABLES  IN 
COMMON  TO  ACCESS  THE  VALUE  OF  THE  NTH  CODE  PACKED  IN  AN  ARRAY. 
GIVEN  N*  THE  LOCATION  OF  THE  CODED  VALUE  IS  DETERMINED  BY  THE 
NUMBER  OF  CODED  VALUES  PER  STORAGE  WORD  (CPW)  AND  THE  LENGTH 
OF  EACH  CODE  (CDLN) .  BOTH  CPW  AND  CDLN  ARE  DETERMINED  ON 
INITIALIZATION  IN  SUBROUTINE  INIT.  FOR  ACCESSING  THE  REQUESTED 
CODE  THE  FUNCTION  RETURNS  L  AND  SHFT .  THE  VALUE  OF  L  IS  THE 
SUBSCRIPT  INDEX  TO  THE  WORD  OF  THE  PACKED  ARRAY  CONTAINING 
THE  POSITION  FOR  THE  CODED  VALUE.  SHFT  IS  AN  INTEGER  MULTI¬ 
PLIER  OR  DIVISOR  WHICH  WILL  MOVE  A  CODED  VALUE  OF  LENGTH  CDLN 
TO  OR  FROM  ITS  POSITION  IN  WORD  L  FROM  OR  TO  THE  LOW  ORDER 
NUMERIC  POSITION. 

COMMON  VARIABLES  USED  -  CDLN  r  CPW  r IERR  *  L  r  MAXN  r  SHFT  t ITMP 
SUBROUTINES  REQUIRED  -  NONE 

COMMON/GCODE/IERRrCPWr ITMPtSHFTrLrMAXNrCDLNrMAXV 
INTEGER  CPWrCDLNtSHFT 

EQUIVALENCE  (Ir IPOS r ITMP) 


- TEST  REQUESTED  CODE  POSITION.  MUST  LIE  WITHIN  DEFINED 

BOUNDARY  OF  CODE  WORD  STRUCTURE. 

IF(N.LE.O)  GO  TO  10 
IF(N.GT.MAXN)  GO  TO  20 


- NORMAL  RETURN.  SET  ERROR  CODE  AND  FUNCTION  VALUE. 

IERR=0 
ECHK=. FALSE. 


- COMPUTE  WORD  ADDRESS  (L)  WITHIN  CODE  LIST  ARRAY*  AND  POSITION 

ADDRESS  (IPOS)  WITHIN  WORD  L  FOR  CODE  LOCATION  N. 

I=N-1 

L*I/CPW 

IPOS=I-L*CPW 

L*L+1 


- COMPUTE  SHIFT  FACTOR  TO  ACCESS  CODE  N  IN  POSITION  IPOS  OF 

WORD  L. 

I*CDLNtIPOS 

SHFT=2**I 

RETURN 


. ERROR  RETURNS. 

10  IERR«3 
60  TO  30 
20  IERRM 
30  ECHK*. TRUE. 

RETURN 

END 

SUBROUTINE  RSET(CODErN) 

SUBROUTINE  RSET  (FOR  RESET)  IS  USED  TO  CLFAR  (I.E.r  SET  TO 
ZERO)  CODE  POSITION  N  FOR  MULTIPLY  VALUED  CODES  STORED  IN  AN 
ARRAY.  DEFINITION  OF  THE  PACKED  CODE  STRUCTURE  IS  OBTAINED 
FROM  THE  MOST  RECENT  CALL  TO  SUBROUTINE  INIT.  IF  N  IS  INVALID* 
IERR  IS  SET  TO  3  OR  4  ON  RETURN  AND  CODE  IS  UNCHANGED.  OTHER¬ 
WISE  IERR*0  ON  RETURN*  AND  ALL  BITS  WITHIN  CODE  N  ARE  RESET. 
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COMMON  VARIABLES  USED  -  ITMPfL.MAXViSHFT 
SUBROUTINES  REQUIRED  -  ECHK 


C0MM0N/GC0DE/IERR»CPU» ITMPfSHFT  fLfHAXNfCDLNfMAXV 
INTEGER  CPWfSHFTfCDLN 


INTEGER 

LOGICAL 


CODEC  1) 
ECHK 


. CHECK  ARGUMENT  N.  RETURN  IF  ERROR. 

IF(ECHK(N) )  RETURN 

- MOVE  MAXIMUM  VALUE  (ALL  BITS  SET)  TO  SHIFTED  POSITION  IN  CODE. 

ITMP=MAXVtSHFT 

— . RESET  THIS  POSITION  IN  WORD  L  OF  CODE  ARRAY. 

C0DE(L)=(.N0T.ITMP). AND. CODE (L) 

RETURN 

END 

SUBROUTINE  SET CCQDEiNfIVAL) 

SUBROUTINE  SET  STORES  THE  INTEGER  VALUE  IVAL  AS  A  CODED 
VALUE  IN  CODE  POSITION  N  OF  THE  ARRAY  CODE.  DEFINITION  OF 
THE  PACKED  CODE  STRUCTURE  IS  OBTAINED  FROM  THE  MOST  RECENT 
CALL  TO  SUBROUTINE  INIT.  SUBROUTINE  SET  FIRST  CLEARS  THE 
VALUE  IN  CODE  POSITION  N  AND  THEN  STORES  IVAL  IF  THE  ARGUMENT 
IS  AN  ACCEPTABLE  CODE  VALUE  IN  THE  RANGE  1  TO  MAXV.  IF  IVAL 
IS  LESS  THAN  ZERO>  CODE  N  IS  SET  TO  ZERO  AND  IERR=5  ON  RETURN. 
IF  IVAL  EXCEEDS  MAXV»  CODE  N  IS  SET  TO  MAXV  AND  IERR-6  ON 
RETURN.  IERR  MAY  ALSO  BE  SET  TO  3  OR  4  IF  N  IS  INVALID  AND 
IN  THIS  CASE  CODE  IS  UNCHANGED  ON  RETURN.  IERR  IS  ZERO  ON 
NORMAL  RETURN  WITH  NO  ERRORS. 

COMMON  VARIABLES  USED  -  IERRf ITMPrL»MAXVrSHFT 

SUBROUTINES  REQUIRED  -  RSET 

COMMON/GCODE/IERRfCPWfITMPfSHFTfLfMAXNfCDLN.MAXV 
INTEGER  CPUiSHFT iCDLN 

INTEGER  CODEC  1 ) 

. -RESET  CODE  STORED  IN  POSITION  N  AND  RETURN  IF  ERROR  ENCOUNTERED 

CALL  RSET (CODE »N) 

IF ( IERR.NE.O)  RETURN 

. RETURN  AFTER  RESET  IF  IVAL  IS  LESS  THAN  OR  EQUAL  TO  ZERO,  IF 

IVAL  IS  LESS  THAN  ZERO  ALSO  SET  EP.ROR  FLAG. 

IFCIVAL.LT, 0)  IERR=5 
IFCIVAL.LE.O)  RETURN 

- TEST  FOR  INPUT  ARGUMENT  LARGER  THAN  MAXIMUM  ALLOWED  CODED  VALUE 

IFCIVAL.GT .MAXV)  GO  TO  20 

. MOVE  CODED  VALUE  TO  POSITION  WITHIN  WORD  L  OF  CODED  ARRAY t 

STORE  AND  RETURN. 

ITMP=IVAL#SHFT 
10  CODEC L)*ITMP. OR. CODECL) 

RETURN 

. IVAL  EXCEEDS  MAXIMUM  ALLOWED  CODED  VALUE.  SET  ERROR  FLAG  THEN 

STORE  MAXIMUM  VALUE. 

20  IERR=6 

ITMP=MAXV*SHFT 
GO  TO  10 
END 
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FUNCTION  ITST(CODE.N) 


FUNCTION  ITST  RETURNS  THE  INTEGER  VALUE  OF  CODE  N  STORED  IN 
A  PACKED  ARRAY  CODE.  IF  N  IS  NOT  WITHIN  THE  RANGE  OF  THE 
PACKED  CODES*  A  VALUE  OF  ZERO  IS  RETURNED  FOR  ITST  AND  IERR 
IS  SET  TO  3  OR  4.  IF  N  IS  VALID*  THE  VALUE  OF  ITST  IS  OBTAINED 
FROM  THE  PACKED  CODE  IN  POSITION  N  IN  THE  RANGE  0  TO  MAXV,  AND 
IERR  IS  RETURNED  AS  ZERO.  DEFINITION  OF  THE  PACKED  CODE 
STRUCTURE  IS  OBTAINED  FROM  THE  MOST  RECENT  CALL  TO  SUB¬ 
ROUTINE  INIT , 

COMMON  VARIABLES  USED  -  ITMP.L.MAXV.SHFT 
SUBROUTINES  REQUIRED  -  ECHK 

COMMON/GCODE/IERR  *  CPW , ITMP . SHFT » L  *MAXN , CDLN » MAXV 
INTEGER  CPU»SHFT*CDLN 


INTEGER 

LOGICAL 


CODE(l) 

ECHK 


- INITIALIZE  FUNCTION  VALUE  AND  RETURN  IF  N  IS  INVALID. 

ITST=0 

IF(ECHK(N) )  RETURN 


- MOVE  CODED  VALUE  IN  WORD  L  TO  LOW  ORDER  POSITION  OF  ITMP. 

ITMP=CODE(L )/SHFT 


- OBTAIN  CODED  VALUE  BY  REMOVING  ANY  BITS  REMAINING  IN  HIGHER 

ORDER  POSITIONS. 

ITST=ITMP. AND. MAXV 

RETURN 

END 

SUBROUTINE  PACK(IAR,CODE) 

SUBROUTINE  PACK  TRANSFERS  DATA  VALUES  FROM  THE  INPUT  ARRAY 
IAR  TO  COMPRESSED  FORMAT  IN  THE  ARRAY  CODE.  THE  PARAMETERS 
OF  THE  COMPACTION  MUST  BE  SET  BY  CALLING  SUBROUTINE  INIT  WITH 
THE  ARRAY  CODE  AS  AN  ARGUMENT  PRIOR  TO  EACH  NEW  USE  OF  THIS 
ROUTINE.  IF  AN  ERROR  IS  DETECTED  BY  SUBROUTINE  INIT.  THE 
CONTENTS  OF  THE  OUTPUT  ARRAY  CODE  ARE  UNCHANGED. 

IF  NO  ERRORS  HAVE  OCCURRED  DURING  INITIALIZATION.  THE  FIRST 
MAXN  VALUES  IN  IAR  ARE  MOVED  TO  PACKED  POSITIONS  IN  CODE. 

THE  VALUES  IN  IAR  ARE  ASSUMED  TO  BE  IN  THE  RANGE  0  TO  MAXV. 

IF  A  NEGATIVE  VALUE  IS  ENCOUNTERED.  THE  ERROR  FLAG  IERR  IS 
SET  TO  5.  AND  A  CODE  VALUE  O.-  ZERO  IS  STORED.  IF  A  VALUE  TN 
IAR  IS  GREATER  THAN  MAXV*  THEN  TERR  IS  SET  TO  6  AND  A  CODE 
VALUE  OF  MAXV  IS  STORED .  ON  RETURN.  IERR  WILL  BE  ZERO  (NO 
ERROR)  OR  SET  TO  THE  LAST  ERROR  CONDITION  (5  OR  6)  ENCOUNTERED. 

BASE  =  INTEGER  QUANTITY  USED  AS  A  MULTIPLIER  TO  SHIFT 
PACKED  VALUE  BY  ONE  CODE  POSITION. 

I  =  INDEX  TO  PACKED  CODE  POSITION  WITHIN  SINGLE  WORD 
OF  ARRAY  CODE.  VARIES  FROM  1  TO  CPW. 

IAR  =  INPUT  INTEGER  ARRAY,  EACH  WORD  CONTAINS  SINGLE 

VALUE  IN  RANGE  0  TO  MAXV  TO  BE  PACKED  INTO  CODE. 
ARRAY  MUST  BE  DIMENSIONED  IN  CALLING  PROGRAM  TO 
LENGTH  OF  MAXN  OR  GREATER. 

J  =  INDEX  TO  ELEMENTS  OF  IAR  TO  BE  PACKED.  VARIES  FROM 

1  TO  MAXN. 

COMMON  VARIABLES  USED  -  CPW. IERR. ITMP. L. MAXN. MAXV. SHFT 
SUBROUTINES  REQUIRED  -  INIT  (PRIOR  CALL) 


COMMON/OCODE/IERR .CPW . ITMP . SHFT .L . MAXN . CDLN . MAXV 
INTEGER  CPW. CDLN. SHFT 


« 
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INTEGER  BASEf CODE ( 1 ) 

DIMENSION  IAR(l) 


- RETURN  IF  ERROR  FLAG  INDICATES  PARAMETERS  OF  DATA  COMPRESSION 

NOT  STORED  IN  COMMON,  OTHERWISE  INITIALIZE  PACKING  SEQUENCE. 
IF(IERR.NE.O)  RETURN 
I=CPW 
L=0 

BASE=HAXV+1 


- OVERALL  LOOP  ON  MAXN  ELEMENTS  OF  IAR  TO  BE  PACKED  INTO  CODE 

DO  40  J=1,MAXN 


- INCREMENT  POSITION  INDEX  I.  ADJUST  SHIFT  FACTOR  TO  NEXT 

POSITION  IF  STILL  IN  SAME  WORD.  IF  CURRENT  WORD  IS  FULL.  SET 
TO  PACK  INTO  FIRST  POSITION  OF  NEXT  WORD. 

1  =  1  +  1 

IF(I.LE.CPW)  GO  TO  10 
L=L+1 
SHFT=1 
1  =  1 

GO  TO  20 

10  SHFT=SHFT*BASE 


- MOVE  CURRENT  VALUE  IN  IAR  TO  ITMP  AND  TEST  MAGNITUDE.  STORE 

ONLY  VALUES  IN  RANGE  0  TO  MAXV.  SET  IERR  TO  5  OR  6  IF  IAR(J) 
IS  OUTSIDE  THIS  RANGE.  AND  SET  ITMP  TO  MAXV  FOR  IERR=6. 

20  ITMP=IAR(J) 

IF(ITMP.LT.O)  IERR=5 
IF(ITMP.LE.O)  GO  TO  40 
IF( ITMP.LE .MAXV)  GO  TO  30 
IERR=4 
ITMP=MAXV 


. SHIFT  CODE  VALUE  IN  ITMP  TO  PACKED  POSITION.  STORE  IN  CODED 

ARRAY  AND  CONTINUE  TO  END  OF  LOOP  ON  VALUES  IN  IAR  INPUT  ARRAY. 
30  ITMP=ITMP*SHFT 

C0DE(L)=CODE<L) .OR. ITMP 
40  CONTINUE 
RETURN 
END 

SUBROUTINE  UNPMCODE, IAR) 

SUBROUTINE  UNPK  MOVES  CODED  VALUES  STORED  IN  ARRAY  CODE  TO 
UNPACKED  INTEGER  FORMAT  IN  ARRAY  IAR.  THE  PARAMETERS  OF  THE 
COMPACTION  MUST  BE  OBTAINED  BY  CALLING  SUBROUTINE  INIT  WITH 
THE  ARRAY  IAR  AS  AN  ARGUMENT  PRIOR  TO  EACH  NEW  USE  OF  THIS 
ROUTINE.  CODED  VALUES  PACKED  IN  THE  ARRAY  CODE  ARE  RETURNED 
AS  MAXN  INTEGER  VALUES.  EACH  IN  THE  RANGE  0  TO  MAXV,  STORED 
IN  WORDS  1  TO  MAXN  OF  IAR,  NO  ERROR  CONDITIONS  ARE  SET  BY 
THIS  ROUTINE. 

I  =  INDEX  TO  PACKED  VALUE  POSITION  WITHIN  SINGLE  WORD 
OF  ARRAY  CODE,  VARIES  FROM  1  TO  CPW. 

IAR  =  OUTPUT  ARRAY  FILLED  ON  RETURN  WITH  MAXN  VALUES 

UNPACKED  FROM  INPUT  ARRAY  CODE.  MUST  BE  DIMENSIONED 
IN  CALLING  PROGRAM  TO  LENGTH  OF  MAXN  OR  GREATER. 

J  =  INDEX  TO  ELEMENTS  OF  IAR  TO  BE  FILLED,  VARIES  FROM 
1  TO  MAXN. 

COMMON  VARIABLES  USED  -  CPW, IERR, ITMP, L, MAXN, MAXV, SHFT 
SUBROUTINES  REQUIRED  -  INIT  (PRIOR  CALL) 


COMMON/GCODE/IERR, CPW, ITMP, SHFT, L, MAXN, CDLN, MAXV 
INTEGER  CPW, SHFT, CDLN 


INTEGER 

DIMENSION 


CODE ( 1 > 
IAR(l) 
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- RETURN  IF  ERROR  FLAG  INDICATES  PARAMETERS  OF  DATA  COMPRESSION 

NOT  STORED  IN  COMMON*  OTHERWISE  INITIALIZE  UNPACKING  SEQUENCE. 
IF(IERR.NE.O)  RETURN 
L=0 
I=CPW 

SHFT=MAXV+1 


- OVERALL  LOOP  ON  ELEMENTS  OF  IAR  TO  BE  FILLED. 

DO  30  J=1 *MAXN 


. INCREMENT  INDEX  TO  PACKED  POSITION  IN  WORD  OF  ARRAY  CODE. 

POSITIONED  BEYOND  CPU*  SELECT  FIRST  POSITION  OF  NEXT  WORD 
AND  STORE  ENTIRE  CODE  WORD  IN  ITMP.  IF  POSITIONED  WITHIN 
CURRENT  WORD*  SHFT  CODE  IN  ITMP  TO  LOW-ORDER  POSITION. 
1=1+1 

IF(I.LE.CPW)  GO  TO  10 
L=L  +  1 

ITMP=CODE(L) 

1  =  1 

GO  TO  20 

10  ITMP=ITMP/SHFT 


IF 


. —MOVE  CODED  VALUE  INTO  IAR*  AND  CONTINUE  CYCLE  UNTIL  ALL 

ELEMENTS  HAVE  BEEN  UNPACKED. 

20  IAR( J)=ITMP. AND.MAXV 
30  CONTINUE 
RETURN 
END 


%  mmmmmmmmmmmmmmmmtmmmm* 

*  t 

*  LEVEL  2  PROGRAM  LISTINGS  * 

*  * 


SUBROUTINE  INITM(CODE* I . J) 


SUBROUTINE  INITM  IS  A  SUB-SET  OF  SUBROUTINE  INIT  EQUIVALENT 
TO  AND  REPLACEABLE  BY  INITICODE. I , J* 1 ) .  THAT  IS*  THIS  ROUTINE 
FIXES  THE  LENGTH  OF  PACKED  CODED  VALUES*  K*  TO  1  FOR  SINGLE 
BIT  CODING  IN  AN  INTEGER  ARRAY.  PROGRAM  CODING  IS  SIMPLIFIED, 
BUT  ALL  OTHER  FUNCTIONS  AND  USE  REMAIN  UNCHANGED.  REFER  TO 
LISTING  OF  SUBROUTINE  INIT  FOR  ADDITIONAL  INFORMATION.  ON 
RETURN,  THE  ERROR  FLAG  I ERR  IS  SET  TO  ZERO  <N0  ERRORS)  OR  TO 
1*2  OR  7. 


COMMON  VARIABLES  USED  -  CPW, IERR*L*MAXN 
SUBROUTINES  REQUIRED  -  NONE 


COMMON/GCODE/IERR*CPW* ITMP* SHFT* L,MAXN 
INTEGER  CPW*SHFT 


INTEGER 

DATA 


CODE ( 1 ) 
MXWRD/47/ 


- TEST  LENGTH  OF  WORD  TO  BE  USED  FOR  CODE  STORAGE.  CANNOT  BE 

LESS  THAN  1  OR  EXCEED  MAXIMUM  UNSIGNED  INTEGER  WORD  LENGTH. 
IF(I.LE.O)  GO  TO  20 
IF(I.GT.MXWRD)  GO  TO  30 


-TEST  NUMBER  OF  WORDS  TO  BE  USED  FOR  CODE  STORAGE. 


LESS  THAN  1.  UPPER  LIMIT  IS  NOT  TESTED  SINCE  THIS 


CONTROLLED  BY  USER  DIMENSION  IN  CALLING  PROGRAM. 
IF(J.LE.O)  GO  TO  40 


CANNOT  BE 
IS 


-NORMAL  RETURN.  SAVE  NUMBER  OF  CODES  TO  BE  STORED  PER  WORD 
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<CPW>*  INITIALIZE  ALL  CODE  WORDS  TO  ZERO*  AND  SET  NORMAL  ERROR 
RETURN.  COMPUTE  TOTAL  NUMBER  OF  CODES  WHICH  CAN  BE  STORED 
(MAXN) ♦ 


DO  10  L«1*J 
10  C0DE(L)-0 
MAXN'CPWtJ 
RETURN 


- ERROR  RETURNS.  SET  VALUE  OF  ERROR  SWITCH  IN  COMMON  AND 

DEFAULT  TO  CODE  DEFINITION  USING  SINGLE  WORD  CONTAINING  CODES 
ONE  BIT  IN  LENGTH. 

20  IERRS1 
GO  TO  70 
30  IERR-2 
GO  TO  70 
40  IERR*7 
70  CPW'MXWRD 
CODEC 1)=0 
NAXN'NXWRD 
RETURN 
END 

LOGICAL  FUNCTION  ECHKM(N) 

LOGICAL  FUNCTION  ECHKM  IS  A  SUB-SET  OF  LOGICAL  FUNCTION  ECHK. 
IN  THIS  VERSION*  THE  FUNCTION  ASSUMES  THE  LENGTH  OF  CODED 
VALUES  IS  SET  TO  1  FOR  PACKING  SINGLE  BIT  CODES  INTO  AN 
INTEGER  ARRAY.  PROGRAM  CODING  IS  SLIGHTLY  SIMPLIFIED*  BUT 
ALL  OTHER  FUNCTIONS  AND  USE  REMAIN  UNCHANGED.  REFER  TO 
LISTING  OF  FUNCTION  ECHK  FOR  ADDITIONAL  INFORMATION.  NOTE 
THAT  THE  ECHK  FUNCTIONS  ARE  ONLY  USED  INTERNALLY  BY  THE 
PACKING  AND  UNPACKING  ROUTINES*  AND  CALLS  TO  ECHK*  ECHKM 
AND  ECHK1  ARE  NOT  INTERCHANGEABLE.  ON  RETURN  FROM  ECHKM* 

THE  ERROR  FLAG  I ERR  IS  SET  TO  ZERO  (NO  ERRORS)  OR  TO  3  OR  4. 

COMMON  VARIABLES  USED  -  CPU»IERR*ITMP*L*MAXN*SHFT 

SUBROUTINES  REQUIRED  -  NONE 


COMMON/GCODE/ IERR *  CPU  *  I TMP *  SHFT  *  L  *  MAXN 
INTEGER  CPW.SHFT 
EQUIVALENCE  (I.IPOS*ITMP) 


- TEST  REQUESTED  CODE  POSITION,  MUST  LIE  WITHIN  DEFINED 

BOUNDARY  OF  CODE  WORD  STRUCTURE. 

I F(N.LE.O)  GO  TO  10 
IF(N.GT.MAXN)  GO  TO  20 


- NORMAL  RETURN.  SET  ERROR  CODE  AND  FUNCTION  VALUE. 

IERR'O 

ECHKM», FALSE. 


- COMPUTE  WORD  ADDRESS  (L)  WITHIN  CODE  LIST  ARRAY*  AND  POSITION 

ADDRESS  (IPOS)  WITHIN  WORD  L  FOR  CODE  LOCATION  N, 

I*N-1 

L°I/CPW 

IPOS«I-L#CPW 

L*L+1 


——COMPUTE  SHIFT  FACTOR  TO  ACCESS  CODE  N  IN  POSITION  IPOS  OF 
WORD  L. 

SHFT'2**IP0S 

RETURN 


-ERROR  RETURNS. 


10  IERR-3 
60  TO  30 
20  IERR'4 
30  ECHKM'. TRUE. 
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RETURN 

END 

SUBROUTINE  RSETM(CODE.N) 

SUBROUTINE  RSETM  IS  A  SUB-SET  OF  SUBROUTINE  RSET  USED  FOR 
SINGLE  BIT  CODES  STORED  UITHIN  AN  ARRAY,  AND  PROGRAM  CODE 
IS  SOMEWHAT  SIMPLIFIED.  BIT  N  IS  RESET  IF  SET .  UNCHANGED  IF 
NOT  SET.  ON  RETURN.  IERR  WILL  BE  SET  TO  3  OR  4  IF  N  IS 
INVALID*  OR  ZERO  IF  N  IS  VALID. 

COMMON  VARIABLES  USED  -  L.SHFT 


SUBROUTINES  REQUIRED 


ECHKM 


COMMON/GCODE/IERR.CPW, ITMP, SHFT  .L.MAXN 
INTEGER  CPW, SHFT 


INTEGER 

LOGICAL 


CODE ( 1 ) 
ECHKM 


- CHECK  ARGUMENT  N,  RETURN  IF  ERROR. 

IF(ECHKH(N) )  RETURN 


- USE  COMPUTED  WORD  LOCATION  AND  SHIFT  FACTOR  TO  RESET  BIT  N. 

CODE ( L ) = ( . NOT . SHFT ) . AND . CODE ( L ) 

RETURN 

END 

SUBROUTINE  SETM(CODEiN) 

SUBROUTINE  SETM  IS  A  SUB-SET  OF  SUBROUTINE  SET  USED  TO  SET 
SINGLE  BIT  CODED  VALUES  STORED  WITHIN  AN  ARRAY.  SINCE  ONLY 
A  SINGLE  VALUE  CAN  BE  SET  (I.E.,  1),  THE  ARGUMENT  IVAL  IS 
ELIMINATED  AND  PROGRAM  CODING  IS  GREATLY  SIMPLIFIED.  SUB¬ 
ROUTINE  SETM  WILL  SET  CODE  POSITION  N  TO  1  IF  UNSET*  OR  LEAVE 
IT  UNCHANGED  IF  ALREADY  SET.  ON  RETURN.  IERR  WILL  BE  SET 
TO  3  OR  4  IF  N  IS  INVALID*  AND  CODE  IS  UNCHANGED  ON  RETURN. 
OTHERWISE.  IERR=0  ON  NORMAL  RETURN, 

COMMON  VARIABLES  USED  -  L.SHFT 

SUBROUTINES  REQUIRED  -  ECHKM 


COMMON/GCODE/IERR . CPW . ITMP . SHFT . L . MAXN 
INTEGER  CPW. SHFT 


INTEGER 

LOGICAL 


CODE < 1 ) 
ECHKM 


- CHECK  ARGUMENT  N.  RETURN  IF  ERROR. 

IF(ECHKM(N) )  RETURN 


- USE  ARRAY  WORD  LOCATION  L  AND  SHIFT  TO  CODE  POSITION*  SHFT. 

COMPUTED  BY  ECHKM  TO  SET  BIT  N. 

CODE (L) “SHFT • OR. CODE (L) 

RETURN 

END 

FUNCTION  ITSTM(CODE*N) 

FUNCTION  ITSTM  IS  A  SUB-SET  OF  FUNCTION  ITST  IN  WHICH  SINGLE 
BIT  CODES  ARE  STORED  IN  AN  ARRAY  OF  PACKED  CODES.  ON  RETURN* 
ITSTM*1  IF  BIT  N  IS  SET*  ZERO  OTHERWISE.  IF  N  IS  NOT  WITHIN 
THE  RANGE  OF  PACKED  CODES,  A  VALUE  OF  ZERO  IS  RETURNED  FOR 
ITSTM  AND  IERR  IS  SET  TO  3  OR  4.  IF  N  IS  VALID*  IERR  IS 
RETURNED  AS  ZERO. 


COMMON  VARIABLES  USED  -  ITMP, L.SHFT 
SUBROUTINES  REQUIRED  -  ECHKM 
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c 

c 


COHMON/GCODE/I ERR » CPU  t ITHP » SHFT » L » HAXN 
INTEGER  CPU • SHFT 


INTEGER 

LOGICAL 


CODE ( 1 ) 
ECHKN 


- INITIALIZE  FUNCTION  VALUE  AND  RETURN  IF  N  IS  INVALID. 

ITSTM=0 

IF(ECHKM(N) )  RETURN 

- HOVE  CODED  VALUE  IN  UORD  L  TO  LOU  ORDER  POSITION  OF  ITHP. 

ITMP=CODE(L)/SHFT 

- OBTAIN  CODED  VALUE  BY  STRIPPING  OFF  ANY  HIGHER  ORDER  BITS 

UHICH  REHAIN. 

ITSTM=ITHP.AND. 1 

RETURN 

END 

SUBROUTINE  PACKH(IARfCODE) 

SUBROUTINE  PACKH  IS  A  SUB-SET  OF  SUBROUTINE  PACK  IN  UHICH 
VALUES  STORED  IN  THE  ARRAY  IAR  ARE  PACKED  INTO  THE  CODE  UORD 
ARRAY  CODE.  PACKH  ASSUHES  THAT  THE  VALUES  STORED  IN  IAR  ON 
INPUT  ARE  ZERO  OR  ONE  SO  THAT  ONLY  SINGLE  BIT  VALUES  ARE 
PACKED  INTO  ARRAY  CODE.  THE  PARAHETERS  OF  THE  COMPACTION  MUST 
BE  SET  BY  CALLING  SUBROUTINE  INITH  UITH  THE  ARRAY  CODE  AS  AN 
ARGUHENT  PRIOR  TO  EACH  NEU  USE  OF  THIS  ROUTINE.  ERROR  CON¬ 
DITIONS  IF  A  VALUE  IN  IAR  IS  LESS  THAN  ZERO  OR  GREATER  THAN 
1  ARE  THE  SAHE  AS  IN  SUBROUTINE  PACK. 

1'IAR'J  «  REFER  TO  LISTING  OF  SUBROUTINE  PACK  FOR  DEFINITIONS 
COHHON  VARIABLES  USED  -  CPW» IERR* ITHP *L* HAXN* SHFT 
SUBROUTINES  REQUIRED  -  INITH  (PRIOR  CALL) 


COHMON/GCODE/IERR»CPUf ITHPtSHFT  *L*MAXN 
INTEGER  CPU* SHFT 

INTEGER  CODE < 1 ) 

DIHENSION  IAR(l) 

- RETURN  IF  ERROR  FLAG  INDICATES  PARAHETERS  OF  DATA  COHPRESSION 

NOT  STORED  IN  COHHON*  OTHERUISE  INITIALIZE  PACKING  SEQUENCE. 
IF(IERR.NE.O)  RETURN 
I=CPU 
L=0 

. OVERALL  LOOP  ON  HAXN  ELEMENTS  OF  IAR  TO  BE  PACKED  INTO  CODE 

DO  40  J=1 *MAXN 

- INCREMENT  POSITION  INDEX  I.  ADJUST  SHIFT  FACTOR  TO  NEXT 

POSITION  IF  STILL  IN  SAHE  UORD.  IF  CURRENT  UORD  IS  FULL*  SET 
TO  PACK  INTO  FIRST  POSITION  OF  NEXT  UORD. 

1=1+1 

IF(I.LE.CPU)  GO  TO  10 
L*L+1 
SHFT=1 
1  =  1 

GO  TO  20 
10  SHFT=2*SHFT 

- HOVE  CURRENT  VALUE  IN  IAR  TO  ITHP  AND  TEST  HAGNITUDE.  STORE 

ONLY  VALUES  0  OR  1.  SET  I ERR  TO  5  OR  6  IF  IAR(J)  IS  NOT  0  OR  1 
AND  SKIP  TO  NEXT  VALUE  IF  ITHP  IS  NOT  GREATER  THAN  ZERO. 

20  ITHP«IAR(J) 

IF ( ITMP.LT .0)  IERR-5 
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IF(ITMP.LE.O)  GO  TO  40 
IF( ITMP.GT . 1 >  IERR=6 


. STORE  CODE  VALUE  IN  PACKED  POSITION  AND  CONTINUE  TO  END 

OF  LOOP  ON  VALUES  IN  IAR  INPUT  ARRAY. 

CODE ( L ) =C0DE ( L ) . OR . SHFT 
40  CONTINUE 
RETURN 
END 

SUBROUTINE  UNPKM(C0DE. IAR) 

SUBROUTINE  UNPKM  IS  A  SUB-SET  OF  SUBROUTINE  UNPK  AND  MOVES 
SINGLE  BIT  CODED  VALUES  <0  OR  1)  FROM  A  PACKED  ARRAY  CODE 
TO  AN  UNPACKED  INTEGER  ARRAY  IAR.  THE  PARAMETERS  OF  THE 
COMPACTION  MUST  BE  OBTAINED  BY  CALLING  SUBROUTINE  INITM  WITH 
THE  ARRAY  IAR  AS  AN  ARGUMENT  PRIOR  TO  EACH  NEW  USE  OF  THIS 
ROUTINE.  CODED  VALUES  PACKED  IN  THE  ARRAY  CODE  ARE  RETURNED 
AS  MAXN  INTEGER  VALUES .  EACH  0  OR  li  STORED  IN  WORDS  1  TO  MAXN 
OF  IAR.  NO  ERROR  CONDITIONS  ARE  SET  BY  THIS  ROUTINE. 

I.IAR.  J  =  REFER  TO  LISTING  OF  SUBROUTINE  UNPK  FOR  DEFINITIONS. 

COMMON  VARIABLES  USED  -  CPW. IERR. ITMP.L.MAXN 

SUBROUTINES  REQUIRED  -  INITM  (PRIOR  CALL) 


COMMON/GCODE/IERR *  CPW . I TMP *  SHFT  » L » MAXN 
INTEGER  CPW.SHFT 


INTEGER 

DIMENSION 


CODE(l) 

IAR(l) 


- RETURN  IF  ERROR  FLAG  INDICATES  PARAMETERS  OF  DATA  COMPRESSION 

NOT  STORED  IN  COMNON»  OTHERWISE  INITIALIZE  UNPACKING  SEQUENCE. 
IF ( IERR.NE.O)  RETURN 
L=0 
I=CPW 


-—OVERALL  LOOP  ON  ELEMENTS  OF  IAR  TO  BE  FILLED 
DO  30  =1 . MAXN 


. INCREMENT  INDEX  TO  PACKED  POSITION  IN  WORD  OF  ARRAY  CODE. 

POSITIONED  BEYOND  CPW.  SELECT  FIRST  POSITION  OF  NEXT  WORD 
AND  STORE  ENTIRE  CODE  WORD  IN  ITMP.  IF  POSITIONED  WITHIN 
CURRENT  WORD.  SHIFT  CODE  IN  ITMP  TO  LOW-ORDER  POSITION. 
1=1+1 

IF(I.LE.CPW)  GO  TO  10 
L=L+1 

ITMP=CODE(L) 

1=1 

GO  TO  20 
10  ITMP=ITMP/2 


IF 


C 

C 

C 

C 


E 

C 


. MOVE  CODED  VALUE  INTO  IAR  AND  CONTINUE  CYCLE  UNTIL  ALL  ELEMENTS 

HAVE  BEEN  UNPACKED. 

20  IAR( J)=ITMP.AND, 1 
30  CONTINUE 
RETURN 
END 

* 

*  LEVEL  3  PROGRAM  LISTINGS 

* 

mtimnmmmttmmimmmmmmmtmmmmi 

SUBROUTINE  INITl(CODE.I) 
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SUBROUTINE  INIT1  IS  A  SUB-SET  OF  SUBROUTINES  INIT  AND  INITM. 

IT  IS  EQUIVALENT  TO  AND  REPLACEABLE  BY  INIKCODE.I.l.l)  OR 
INI TM < CODE f I » 1 ) .  THAT  IS.  THIS  ROUTINE  FIXES  THE  LENGTH  OF 

F?i^iDTfigDESHii»huS?’,8t  SgRiy?sJ;MTiNrPiRAg?6«IgE*8PIJifie4 

WITHIN  A  SINGLE  WORD.  PROGRAM  CODING  IS  SIMPLIFIED.  BUT  ALL 
OTHER  FUNCTIONS  AND  USE  REMAIN  UNCHANGED.  REFER  TO  LISTING  OF 
SUBROUTINE  INIT  FOR  ADDITIONAL  INFORMATION.  ON  RETURN.  THE 
ERROR  FLAG  IERR  IS  SET  TO  ZERO  (NO  ERRORS)  OR  TO  1  OR  2. 

COMMON  VARIABLES  USED  -  CPU. IERR 

SUBROUTINES  REQUIRED  -  NONE 


COMMON/GCODE/IERR.CPU.ITMP.SHFT 
INTEGER  CPW.SHFT 


INTEGER 

DATA 


CODE 

MXWRD/47/ 


- TEST  LENGTH  OF  WORD  TO  BE  USED  FOR  CODE  STORAGE.  CANNOT  BE 

LESS  THAN  1  OR  EXCEED  MAXIMUM  UNSIGNED  INTEGER  UORD  LENGTH. 
IF(I.LE.O)  GO  TO  20 
IF(I.GT.MXURD)  GO  TO  30 


- NORMAL  RETURN.  SAVE  NUMBER  OF  CODES  TO  BE  STORED  IN  SINGLE 

CODE  UORD  (CPU).  INITIALIZE  CODE  UORD  TO  ZERO  AND  SET  NORMAL 
ERROR  RETURN. 

IERR=0 
CPU=I 
10  CODE=0 
RETURN 


. ERROR  RETURNS.  SET  VALUE  OF  ERROR  SWITCH  IN  COMMON  AND 

DEFAULT  TO  CODE  DEFINITION  FOR  SINGLE  UORD  CONTAINING  UP  TO 
MXURD  SINGLE  BIT  CODES. 

20  IERR=1 
GO  TO  70 
30  IERR=2 
70  CPU=MXWRD 
GO  TO  10 
END 

LOGICAL  FUNCTION  ECHKKN) 

LOGICAL  FUNCTION  ECHK1  IS  A  SUB-SET  OF  FUNCTIONS  ECHK  AND 
ECHKH.  THAT  IS.  THE  ROUTINE  ASSUMES  A  FIXED  LENGTH  OF  PACKED 
CODED  VALUES  OF  1  AS  IN  ECHKM.  AND.  IN  ADDITION.  ASSUMES  THAT 
ALL  PACKED  CODED  VALUES  ARE  STORED  IN  A  SINGLE  UORD.  NOT  IN  AN 
ARRAY.  PROGRAM  CODING  IS  SIMPLIFIED.  BUT  THE  BASIC  FUNCTION 
AND  USE  OF  THE  ROUTINE  ARE  UNCHANGED.  REFER  TO  LISTING  OF 
FUNCTION  ECHK  FOR  ADDITIONAL  INFORMATION.  ON  RETURN  FROM  „ 
ECHK1.  THE  ERROR  FLAG  IERR  IS  SET  TO  ZERO  (NO  ERRORS)  OR  TO 
3  OR  4. 

COMMON  VARIABLES  USED  -  CPU. IERR. ITMP.SHFT 
SUBROUTINES  REQUIRED  -  NONE 


COMHON/GCODE/ IERR . CPU » ITMP . SHFT 
INTEGER  CPU. SHFT 
EQUIVALENCE  (IPOS. ITMP) 


C 

C- 


- TEST  REQUESTED  CODE  POSITION.  MUST  LIE  WITHIN  DEFINED 

BOUNDARY  OF  CODE  UORD.  NOTE  CPU  EXCHANGED  FOR  NAXN. 
IF(N.LE.O)  GO  TO  10 
IF(N.GT.CPW)  60  TO  20 


-NORMAL  RETURN.  SET  ERROR  CODE  AND  FUNCTION  VALUE. 
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IERR*0 

ECHK1-. FALSE. 

- COMPUTE  SHIFT  FACTOR  TO  CODE  N  POSITION  WITHIN  SINGLE  PACKED 

CODE  WORD. 

IP0S=N-1 

SHFT»2**IP0S 

RETURN 

- ERROR  RETURNS 

10  IERRs3 
GO  TO  30 
20  IERR=4 
30  ECHK1=.TRUE< 

RETURN 

END 

SUBROUTINE  RSET1(C0DE,N) 

SUBROUTINE  RSET1  IS  A  SUB-SET  OF  SUBROUTINES  RSET  AND  RSETM 
USED  FOR  SINGLE  BIT  CODES  STORED  WITHIN  A  SINGLE  CODE  WORD. 
PROGRAM  CODE  IS  SOMEWHAT  SIMPLIFIED.  BIT  N  IS  RESET  IF  SET, 
UNCHANGED  IF  NOT  SET.  ON  RETURN,  IERR  WILL  BE  SET  TO  3  OR  4 
IF  N  IS  INVALID,  ZERO  OTHERWISE. 

COMMON  VARIABLES  USED  -  SHFT 

SUBROUTINES  REQUIRED  -  ECHK1 


COMMON/GCQDE/IERR,CPW, ITMP,SHFT 
INTEGER  CPW,SHFT 

INTEGER  CODE 

LOGICAL  ECHK1 


- CHECK  ARGUMENT  N,  RETURN  IF  ERROR. 

IF(ECHK1(N) )  RETURN 


- USE  COMPUTED  SHIFT  FACTOR  TO  RESET  BIT  N  IN  CODE  WORD. 

CODE3 ( . NOT . SHFT ) . AND . CODE 

RETURN 

END 

SUBROUTINE  SET1(C0DE,N) 

SUBROUTINE  SET1  IS  A  SUB-SET  OF  SUBROUTINES  SET  AND  SETM.  A 
SINGLE  BIT  CODED  VALUE  IS  SET  WITHIN  A  SINGLE  CODE  WORD.  SINCE 
ONLY  A  SINGLE  VALUE  CAN  BE  SET  (I.E.r  1),  THE  ARGUMENT  IVAL  IS 
ELIMINATED  AND  PROGRAM  CODING  IS  GREATLY  SIMPLIFIED.  SUB¬ 
ROUTINE  SET1  WILL  SET  CODE  POSITION  N  TO  1  IF  UNSET,  OR  LEAVE 
IT  UNCHANGED  IF  ALREADY  SET.  ON  RETURN,  IERR  WILL  BE  SET  TO 
3  OR  4  IF  N  IS  INVALID,  AND  CODE  IS  UNCHANGED  ON  RETURN. 
OTHERWISE  IERR*0  ON  NORMAL  RETURN. 

COMMON  VARIABLES  USED  -  SHFT 


SUBROUTINES  REQUIRED 


ECHK1 


COMHON/GCODE/IERR,CPW,ITMP, SHFT 
INTEGER  CPWfSHFT 

INTEGER  CODE 

LOGICAL  ECHK1 


- CHECK  ARGUMENT  N,  RETURN  IF  ERROR. 

IF(ECHK1(N))  RETURN 

E - —USE  SHIFT  TO  CODE  POSITION  N  COMPUTED  BY  ECHK1  TO  SET  BIT  N. 

CODE* SHFT. OR. CODE 
RETURN 
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r UNCTION  ITST1 (CODE.N) 

FUNCTION  ITST1  IS  A  SUB-SET  OF  FUNCTIONS  ITST  AND  ITSTH  IN  * 
WHICH  SINGLE  BIT  CODES  ARE  STORED  IN  A  SINGLE  PACKED  CODE  WORD. 
ON  RETURN*  ITST1=1  IF  BIT  N  IS  SET*  ZERO  OTHERWISE.  IF  N  IS 
NOT  WITHIN  THE  RANGE  OF  PACKED  CODES*  A  VALUE  OF  ZERO  IS 
RETURNED  FOR  ITST1  AND  I ERR  IS  SET  TO  3  OR  4.  IF  N  IS  VALID* 

I ERR  IS  RETURNED  AS  ZERO. 

COHHON  VARIABLES  USED  -  ITMP.SHFT 

SUBROUTINES  REQUIRED  -  ECHK1 


COHNON/GCODE/IERR *  CPW* ITMP.SHFT 
INTEGER  CPW.SHFT 

INTEGER  CODE 

LOGICAL  F.CHK1 


- INITIALIZE  FUNCTION  VALUE  AND  RETURN  IF  N  IS  INVALID. 

ITST1*0 

IF(ECHKKN))  RETURN 

- MOVE  CODED  VALUE  IN  CODE  WORD  TO  LOW  ORDER  POSITION  OF  ITMP. 

ITMP=CODE/SHFT 

-—OBTAIN  CODED  VALUE  BY  STRIPPING  OFF  ANY  HIGHFR  ORDER  BITS 
WHICH  REMAIN. 

ITST1=ITMP.AND. 1 

RETURN 

END 

SUBROUTINE  PACKl(IAR.CODE) 

SUBROUTINE  PACK1  IS  A  SUB-SET  OF  SUBROUTINES  PACK  AND  PACKM. 
THAT  IS*  INPUT  VALUES  OF  ZERO  OR  ONE  STORED  IN  THE  ARRAY  IAR 
ARE  PACKED  INTO  A  SINGLE  WORD*  CODE.  THE  PARAMETERS  OF  THE 
COMPACTION  MUST  BE  SET  BY  CALLING  SUBROUTINE  INIT]  WITH  CODE 
AS  AN  ARGUMENT  PRIOR  TO  EACH  NEW  USE  OF  THIS  ROUTINE.  ERROR 
CONDITIONS  IF  A  VALUE  IN  IAR  IS  LESS  THAN  ZERO  OR  GREATER  THAN 
1  ARE  THE  SAME  AS  IN  SUBROUTINE  PACK. 

IAR* J  *  REFER  TO  LISTING  OF  SUBROUTINE  PACK  FOR  DEFINITIONS 
COMMON  VARIABLES  USED  -  CPW* IERR* ITMP.SHFT 
SUBROUTINES  REQUIRED  -  INIT1  (PRIOR  CALL) 


COMMON/BCODE/ IERR *  CPW  *  I TMP  *  SHFT 
INTEGER  CPW. SHFT 

INTEGER  CODE 

DIMENSION  IAR(1) 


—RETURN  IF  ERROR  FLAG  INDICATES  PARAMETERS  OF  DATA  COMPRESSION 
NOT  STORED  IN  COMMON*  OTHERWISE  INITIALIZE  PACKING  SEQUENCE. 
IF(IERR.NE.O)  RETURN 


-RETURN  HERE  FOR  EACH  NEXT  VALUE  IN  IAR  TO  BE  PACKED.  MOVE 
VALUE  FROM  IAR  TO  ITMP  AND  TEST  MAGNITUDE.  STORE  ONLY  VALUES 
0  OR  I.  SET  IERR  TO  5  OR  6  IF  IAR(J)  IS  NOT  0  OR  1  AND  THEN 


KIP  TO  NEXT 
IAR(J) 


.....  _  VALUE  IF 

10  ITMF>fAR<J> 

vm:m  iSR?o53o 

IF(ITMP.GT.l)  IERR'6 


ITMP  IS  NOT  GREATER  THAN  ZERO. 
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- STORE  CODE  VALUE  IN  PACKED  POSITION. 

C0D£*C0DE . OR . SHFT 


- INCREMENT  INDEX  TO  INPUT  WORDS  IN  IAR.  RETURN  AFTER  CPU  WORDS 

HAVE  BEEN  PACKED t  OTHERWISE  INCREMENT  SHIFT  FACTOR  AND  CONTINUE 
CYCLE  TO  PACK  NEXT  VALUE. 

30  J*J+1 

IF( J.GT.CPW)  RETURN 
SHFT=2*SHFT 
60  TO  10 
END 

SUBROUTINE  UNPKl(CODEiIAR) 

SUBROUTINE  UNPK1  IS  A  SUB-SET  OF  SUBROUTINES  UNPK  AND  UNPKM 
AND  MOVES  SINGLE  BIT  CODED  VALUES  <0  OR  1)  FROM  A  SINGLE 
PACKED  WORD  (CODE)  TO  AN  UNPACKED  INTEGER  ARRAY  IAR.  THE 
PARAMETERS  OF  THE  COMPACTION  MUST  BE  OBTAINED  BY  CALLING 
SUBROUTINE  INIT1  WITH  THE  ARRAY  IAR  AS  AN  ARGUMENT  PRIOR  TO 
EACH  NEW  USE  OF  THIS  ROUTINE.  CODED  VALUES  PACKED  IN  THE 
SINGLE  WORD  CODE  ARE  RETURNED  AS  CPU  INTEGER  VALUES.  EACH  0  OR 
1.  STORED  IN  WORDS  I  TO  CPU  OF  IAR.  NO  ERROR  CONDITIONS  ARE 
SET  BY  THIS  ROUTINE. 

IAR»J  *  REFER  TO  LISTING  OF  SUBROUTINE  UNPK  FOR  DEFINITIONS. 
COMMON  VARIABLES  USED  -  CPWiIERR* ITMP 
SUBROUTINES  REQUIRED  -  INIT1  (PRIOR  CALL) 


CONMON/GCODE/ IERR . CPU i ITMP » SHFT 
INTEGER  CPW'SHFT 


INTEGER 

DIMENSION 


CODE 

IAR(1) 


RETURN  IF  ERROR  FLAG  INDICATES  PARAMETERS  OF  DATA  COMPRESSION 
NOT  STORED  IN  COHMONi  OTHERWISE  MOVE  CODE  WORD  TO  TEMPORARY 
LOCATION  FOR  MANIPULATION. 

IF(IERR.NE.O)  RETURN 
ITMP-CODE 


- LOOP  ON  ELEMENTS  OF  IAR  TO  BE  FILLED.  SET  EACH  TO  LOW-ORDER 

VALUE  OF  ITMP«  THEN  SHIFT  ITMP  ONE  POSITION.  CONTINUE  LOOP 
UNTIL  ALL  CPU  ELEMENTS  OF  IAR  ARE  SET. 

DO  10  J*1.CPW 
IAR(J)-ITMP.AND.l 
10  ITMP«ITMP/2 
RETURN 
END 


READY. 


tmmmmmmmummummmtmmmmmmm 

*  * 

*  END  * 

*  I 
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7. A. 2  Tab  Key  (File  SAVCNV) 


PROGRAM  CNV(TAPEIOfTAPEII) 

INTEGER  BLK*BUFF(80) »COM»0UTB(8O) »TAB 
DATA  BLK/1H  /fCOM/IHC/fTAB/IH"/ 

REWIND  11 

10  READ( 10» 1000)  BUFF 
1000  FORMAT  (80A1) 

IF (E0F(10) )  90f15 
IS  CONTINUE 

IF<BUFF(1). NE.COM)  GO  TO  SO 
0UTB(1)-C0M 

IF(BUFF(2> .NE.TAB )  GO  TO  40 
DO  20  I=2»9 
20  OUTB(I)*BLK 
M=10 
N=4 

IF(BUFF(4) .NE.TAB)  GO  TO  80 
DO  30  I=10»20 
30  OUTB(I)-BLK 
M=21 
N=6 

GO  TO  80 
40  M=2 

N=2 

GO  TO  80 

50  IF(BUFFd). NE.TAB)  GO  TO  70 
DO  60  1=1 r 6 
60  OUTB<I)=BLK 
M=7 
N=3 

GO  TO  80 
70  M=1 
N=1 

80  OUTB(M)=BUFF(N) 

M=M41 

N*N+1 

IF<M<LE<80 )  GO  TO  80 
WRITE(llflOlO)  OUTB 
1010  FORHAT  (80A1) 

GO  TO  10 
90  ENDFILE  11 
REWIND  11 
END 

READY. 


*U.I.  GOVERNMENT  PRINTING  OFFICE'  ItGt-lGI' 
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